[project @ 2004-11-26 11:58:18 by simonmar]
[ghc-base.git] / Data / Generics / Basics.hs
index c03dff1..5d3f80f 100644 (file)
@@ -1,7 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- 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
 
 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
        Data( 
                gfoldl,         -- :: ... -> a -> c a
+               gunfold,        -- :: ... -> Constr -> 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,
         gmapMo,
 
+       -- * Generic operation(s) defined in terms of gunfold
+        fromConstr,    -- :: Constr -> a
+        fromConstrB,   -- :: ... -> Constr -> a
+       fromConstrM     -- :: Monad m => ... -> Constr -> m a
+
   ) where
 
 
 ------------------------------------------------------------------------------
 
-#ifdef __HADDOCK__
-import Prelude
-#endif
+import Prelude -- necessary to get dependencies right
+
 import Data.Typeable
 import Data.Maybe
 import Control.Monad
 
+
+
 ------------------------------------------------------------------------------
 --
 --     The Data class
@@ -96,14 +133,14 @@ class Typeable a => Data a where
 
 Folding constructor applications ("gfoldl")
 
-The combinator takes two arguments "f" and "z" to fold over a term
+The combinator takes two arguments "k" and "z" to fold over a term
 "x".  The result type is defined in terms of "x" but variability is
 achieved by means of type constructor "c" for the construction of the
 actual result type. The purpose of the argument "z" is to define how
 the empty constructor application is folded. So "z" is like the
 neutral / start element for list folding. The purpose of the argument
-"f" is to define how the nonempty constructor application is
-folded. That is, "f" takes the folded "tail" of the constructor
+"k" is to define how the nonempty constructor application is
+folded. That is, "k" takes the folded "tail" of the constructor
 application and its head, i.e., an immediate subterm, and combines
 them in some way. See the Data instances in this file for an
 illustration of "gfoldl". Conclusion: the type of gfoldl is a
@@ -122,6 +159,11 @@ fold.
   --
   gfoldl _ z = z
 
+  -- | Unfolding constructor applications
+  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
+          -> (forall r. r -> c r)
+          -> Constr
+          -> c a
 
   -- | Obtaining the constructor from a given datum.
   -- For proper terms, this is meant to be the top-level constructor.
@@ -131,14 +173,31 @@ fold.
   toConstr   :: a -> Constr
 
 
-  -- | Building a term from a constructor
-  fromConstr   :: Constr -> a
-
-
   -- | Provide access to list of all constructors
   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 +268,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
 
@@ -282,6 +350,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 }
 
@@ -293,46 +365,99 @@ newtype Mp m x = Mp { unMp :: m (x, Bool) }
 
 ------------------------------------------------------------------------------
 --
---     Constructor representations
+--     Generic unfolding
 --
 ------------------------------------------------------------------------------
 
 
--- | Representation of constructors
-data Constr =
-       -- The prime case for proper datatype constructors
-              DataConstr ConIndex String Fixity
+-- | Build a term skeleton
+fromConstr :: Data a => Constr -> a
+fromConstr = fromConstrB undefined
 
-       -- Provision for built-in types
-           | IntConstr     Int
-           | IntegerConstr Integer
-           | FloatConstr   Float
-           | CharConstr    Char
 
-       -- Provision for any type that can be read/shown as string
-           | StringConstr  String
+-- | Build a term and use a generic function for subterms
+fromConstrB :: Data a
+            => (forall a. Data a => a)
+            -> Constr
+            -> a
+fromConstrB f = unID . gunfold k z
+ where
+  k c = ID (unID c f)
+  z = ID
 
-       -- Provision for function types
-           | FunConstr
 
-              deriving (Show, Typeable)
+-- | Monadic variation on \"fromConstrB\"
+fromConstrM :: (Monad m, Data a)
+            => (forall a. Data a => m a)
+            -> Constr
+            -> m a
+fromConstrM f = gunfold k z 
+ where
+  k c = do { c' <- c; b <- f; return (c' b) }
+  z = return
 
--- 
--- Equality of datatype constructors via index.
--- Use designated equalities for primitive types.
--- 
+
+
+------------------------------------------------------------------------------
+--
+--     Datatype and constructor representations
+--
+------------------------------------------------------------------------------
+
+
+--
+-- | 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
+                       }
+
+              deriving Show
+
+
+-- | Representation of constructors
+data Constr = Constr
+                       { conrep    :: ConstrRep
+                       , constring :: String
+                       , confields :: [String] -- for AlgRep only
+                       , confixity :: Fixity   -- for AlgRep only
+                       , datatype  :: DataType
+                       }
+
+instance Show Constr where
+ show = constring
+
+
+-- | 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
 
@@ -340,309 +465,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.
+
+------------------------------------------------------------------------------
 --
-data DataType =
-       -- The prime case for algebraic datatypes
-              DataType [Constr]
+--     Observers for datatype representations
+--
+------------------------------------------------------------------------------
 
-       -- 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
 
-------------------------------------------------------------------------------
---
---     Constructing constructor representations
---
-------------------------------------------------------------------------------
 
+-- | Gets the public presentation of constructors
+constrRep :: Constr -> ConstrRep
+constrRep = conrep
 
--- | Make a representation for a datatype constructor
-mkConstr   :: ConIndex -> String -> Fixity -> Constr
---     ToDo: consider adding arity?
-mkConstr = DataConstr
 
--- | Make a package of constructor representations
-mkDataType :: [Constr] -> DataType
-mkDataType = DataType
+-- | 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"
+
 
 
 ------------------------------------------------------------------------------
 --
---     Observing constructor representations
+--     Representations of algebraic 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            = "->"
+-- | 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 ]
 
 
--- | Determine fixity of a constructor;
---   undefined for primitive types.
-conFixity :: Constr -> Fixity
-conFixity (DataConstr _ _ fix) = fix
-conFixity _                    = undefined
+-- | Gets the constructors
+dataTypeConstrs :: DataType -> [Constr]
+dataTypeConstrs dt = case datarep dt of 
+                       (AlgRep cons) -> cons
+                       _ -> error "dataTypeConstrs"
 
 
--- | Determine index of a constructor.
---   Undefined for primitive types.
-conIndex   :: Constr -> ConIndex
-conIndex (DataConstr idx _ _) = idx
-conIndex _                    = undefined
+-- | Gets the field labels of a constructor
+constrFields :: Constr -> [String]
+constrFields = confields
 
 
--- | 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
+-- | Gets the fixity of a constructor
+constrFixity :: Constr -> Fixity
+constrFixity = confixity
 
-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
 
 
--- | 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
+------------------------------------------------------------------------------
+--
+--     From strings to constr's and vice versa: all data types
+--     
+------------------------------------------------------------------------------
 
 
--- | Return maximum index;
---   0 for primitive types
-maxConIndex :: DataType -> ConIndex
-maxConIndex (DataType cs) = length cs
-maxConIndex _ = 0 -- otherwise
+-- | Gets the string for a constructor
+showConstr :: Constr -> String
+showConstr = constring
 
 
--- | Return all constructors in increasing order of indicies;
--- empty list for primitive types
-dataTypeCons :: DataType -> [Constr] 
-dataTypeCons (DataType cs) = cs
-dataTypeCons _ = [] -- otherwise
+-- | 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
+
+    -- 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)
 
 
 ------------------------------------------------------------------------------
 --
---     Instances of the Data class for Prelude types
+--     Convenience funtions: algebraic data 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.
---
+-- | Test for an algebraic type
+isAlgType :: DataType -> Bool
+isAlgType dt = case datarep dt of
+                (AlgRep _) -> True
+                _ -> False 
 
-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
+-- | Gets the constructor for an index
+indexConstr :: DataType -> ConIndex -> Constr
+indexConstr dt idx = case datarep dt of
+                       (AlgRep cs) -> cs !! (idx-1)
+                       _           -> error "indexConstr"
 
 
---
--- Lists as an example of a polymorphic algebraic datatype.
--- Cons-lists are terms with two immediate subterms.
---
+-- | Gets the index of a constructor
+constrIndex :: Constr -> ConIndex
+constrIndex con = case constrRep con of
+                    (AlgConstr idx) -> idx
+                   _ -> error "constrIndex"
 
-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
+-- | Gets the maximum constructor index
+maxConstrIndex :: DataType -> ConIndex
+maxConstrIndex dt = case dataTypeRep dt of
+                       AlgRep cs -> length cs
+                       _            -> error "maxConstrIndex"
 
---
--- 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')
 
 
+------------------------------------------------------------------------------
 --
--- Yet another polymorphic datatype constructor
--- No surprises.
+--     Representation of primitive types
 --
+------------------------------------------------------------------------------
 
-nothingConstr = mkConstr 1 "Nothing" Prefix
-justConstr    = mkConstr 2 "Just"    Prefix
-maybeDataType = mkDataType [nothingConstr,justConstr]
 
-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
+-- | Constructs the Int type
+mkIntType :: String -> DataType
+mkIntType = mkPrimType IntRep
 
 
---
--- Yet another polymorphic datatype constructor.
--- No surprises.
---
+-- | Constructs the Float type
+mkFloatType :: String -> DataType
+mkFloatType = mkPrimType FloatRep
 
-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
+-- | Constructs the String type
+mkStringType :: String -> DataType
+mkStringType = mkPrimType StringRep
 
 
---
--- Yet another polymorphic datatype constructor.
--- No surprises.
---
-tripleConstr = mkConstr 1 "(,,)" Infix
-tripleDataType = mkDataType [tripleConstr]
-
-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 _ = tripleConstr
-  fromConstr c = case conIndex c of
-                   1 -> (undefined,undefined,undefined)
-  dataTypeOf _ = tripleDataType
-quadrupleConstr = mkConstr 1 "(,,,)" Infix
-quadrupleDataType = mkDataType [quadrupleConstr]
-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 _ = quadrupleConstr
-  fromConstr c = case conIndex c of
-                   1 -> (undefined,undefined,undefined,undefined)
-  dataTypeOf _ = quadrupleDataType
+-- | Helper for mkIntType, mkFloatType, mkStringType
+mkPrimType :: DataRep -> String -> DataType
+mkPrimType dr str = DataType
+                       { tycon   = str
+                       , datarep = dr
+                       }
+
+
+-- 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"
+                       }
+
+
+mkIntConstr :: DataType -> Integer -> Constr
+mkIntConstr dt i = case datarep dt of
+                 IntRep -> mkPrimCon dt (show i) (IntConstr i)
+                 _ -> error "mkIntConstr"
+
+
+mkFloatConstr :: DataType -> Double -> Constr
+mkFloatConstr dt f = case datarep dt of
+                   FloatRep -> mkPrimCon dt (show f) (FloatConstr f)
+                   _ -> error "mkFloatConstr"
+
 
+mkStringConstr :: DataType -> String -> Constr
+mkStringConstr dt str = case datarep dt of
+                      StringRep -> mkPrimCon dt str (StringConstr str)
+                      _ -> error "mkStringConstr"
 
+
+------------------------------------------------------------------------------
 --
--- Yet another polymorphic datatype constructor.
--- No surprises.
+--     Non-representations for non-presentable types
 --
+------------------------------------------------------------------------------
 
-leftConstr     = mkConstr 1 "Left"  Prefix
-rightConstr    = mkConstr 2 "Right" Prefix
-eitherDataType = mkDataType [leftConstr,rightConstr]
 
-instance (Data a, Data b) => Data (Either a b) where
-  gfoldl f z (Left a)   = z Left  `f` a
-  gfoldl f z (Right a)  = z Right `f` a
-  toConstr (Left _)  = leftConstr
-  toConstr (Right _) = rightConstr
-  fromConstr c = case conIndex c of
-                   1 -> Left undefined
-                   2 -> Right undefined
-  dataTypeOf _ = eitherDataType
+-- | 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 
 
-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
 
--}
 
--- A last resort for functions
-instance (Typeable a, Typeable b) => Data (a -> b) where
-  toConstr _   = FunConstr
-  fromConstr _ = undefined
-  dataTypeOf _ = FunType
+------------------------------------------------------------------------------
+--
+--     Convenience for qualified type constructors
+--
+------------------------------------------------------------------------------
+
+
+-- | Gets the unqualified type constructor
+-- Drop *.*.*... before name
+--
+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')