[project @ 2004-03-30 15:31:35 by ralf]
[ghc-base.git] / Data / Generics / Basics.hs
index e7c8c76..d3d8e0c 100644 (file)
 
 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
-               ext1,           -- type extension for unary type constructors
-               ext2            -- type extension for binary type constructors
+               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,
@@ -58,6 +87,11 @@ module Data.Generics.Basics (
         gmapMp,
         gmapMo,
 
+       -- * Generic operation(s) defined in terms of gunfold
+        fromConstr,    -- :: Constr -> a
+        fromConstrB,   -- :: ... -> Constr -> a
+       fromConstrM     -- :: Monad m => ... -> Constr -> m a
+
   ) where
 
 
@@ -66,6 +100,7 @@ module Data.Generics.Basics (
 #ifdef __HADDOCK__
 import Prelude
 #endif
+
 import Data.Typeable
 import Data.Maybe
 import Control.Monad
@@ -100,14 +135,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
@@ -126,6 +161,12 @@ 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.
   -- Primitive datatypes are here viewed as potentially infinite sets of
@@ -134,10 +175,6 @@ fold.
   toConstr   :: a -> Constr
 
 
-  -- | Building a term from a constructor
-  fromConstr   :: Constr -> a
-
-
   -- | Provide access to list of all constructors
   dataTypeOf  :: a -> DataType
 
@@ -145,24 +182,22 @@ fold.
 
 ------------------------------------------------------------------------------
 --
--- Type extension for unary and binary type constructors
+-- Mediate types and type constructors
 --
 ------------------------------------------------------------------------------
 
-  -- | Type extension for unary type constructors
-  ext1 :: Typeable1 t
-       => c a
-       -> (forall a. Data a => c (t a))
-       -> c a
-
-  ext1 def ext = def
+  -- | 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
 
-  -- | Type extension for binary type constructors
-  ext2 :: Typeable2 t
-       => c a
-       -> (forall a b. (Data a, Data b) => c (t a b)) -> c a
-  ext2 def ext = def
 
 
 ------------------------------------------------------------------------------
@@ -243,7 +278,7 @@ unit.
 
   -- | 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 _ (Just q) -> q } 
+  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
@@ -332,46 +367,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
 
@@ -379,328 +467,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
 
-------------------------------------------------------------------------------
---
---     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
 
---
--- () 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 
 
-emptyTupleConstr = mkConstr 1 "()" Prefix
-unitDataType     = mkDataType [emptyTupleConstr]
 
-instance Data () where
-  toConstr _ = emptyTupleConstr
-  fromConstr c | conIndex c == 1 = ()  
-  dataTypeOf _ = unitDataType
+-- | Gets the constructor for an index
+indexConstr :: DataType -> ConIndex -> Constr
+indexConstr dt idx = case datarep dt of
+                       (AlgRep cs) -> cs !! (idx-1)
+                       _           -> error "indexConstr"
 
---
--- Bool as another trivial algebraic datatype;
--- define top-level definitions for representations.
---
 
-falseConstr  = mkConstr 1 "False" Prefix
-trueConstr   = mkConstr 2 "True"  Prefix
-boolDataType = mkDataType [falseConstr,trueConstr]
+-- | Gets the index of a constructor
+constrIndex :: Constr -> ConIndex
+constrIndex con = case constrRep con of
+                    (AlgConstr idx) -> idx
+                   _ -> error "constrIndex"
 
-instance Data Bool where
-  toConstr False = falseConstr
-  toConstr True  = trueConstr
-  fromConstr c = case conIndex c of
-                   1 -> False
-                   2 -> True
-  dataTypeOf _ = boolDataType
 
+-- | Gets the maximum constructor index
+maxConstrIndex :: DataType -> ConIndex
+maxConstrIndex dt = case dataTypeRep dt of
+                       AlgRep cs -> length cs
+                       _            -> error "maxConstrIndex"
 
+
+
+------------------------------------------------------------------------------
 --
--- Lists as an example of a polymorphic algebraic datatype.
--- Cons-lists are terms with two immediate subterms.
+--     Representation of primitive types
 --
+------------------------------------------------------------------------------
 
-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
-  ext1 def ext = maybe def id (cast1 ext)
+-- | Constructs the Int type
+mkIntType :: String -> DataType
+mkIntType = mkPrimType IntRep
 
 
---
--- 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')
+-- | Constructs the Float type
+mkFloatType :: String -> DataType
+mkFloatType = mkPrimType FloatRep
 
 
---
--- Yet another polymorphic datatype constructor
--- No surprises.
---
+-- | Constructs the String type
+mkStringType :: String -> DataType
+mkStringType = mkPrimType StringRep
 
-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
-  ext1 def ext = maybe def id (cast1 ext)
+-- | Helper for mkIntType, mkFloatType, mkStringType
+mkPrimType :: DataRep -> String -> DataType
+mkPrimType dr str = DataType
+                       { tycon   = str
+                       , datarep = dr
+                       }
 
 
---
--- Yet another polymorphic datatype constructor.
--- No surprises.
---
+-- 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"
+                       }
 
-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
-  ext2 def ext = maybe def id (cast2 ext)
+mkIntConstr :: DataType -> Integer -> Constr
+mkIntConstr dt i = case datarep dt of
+                 IntRep -> mkPrimCon dt (show i) (IntConstr i)
+                 _ -> error "mkIntConstr"
 
 
---
--- 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
+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
-  ext2 def ext = maybe def id (cast2 ext)
+-- | 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 (Data a, Data b) => Data (a -> b) where
-  toConstr _   = FunConstr
-  fromConstr _ = undefined
-  dataTypeOf _ = FunType
-  ext2 def ext = maybe def id (cast2 ext)
+------------------------------------------------------------------------------
+--
+--     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')