-----------------------------------------------------------------------------
-- |
-- 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
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]
+ Fixity(..), -- instance of: Eq, Show
+
+ -- * 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,
- gmapL,
+ gmapQl,
+ gmapQr,
+ gmapQi,
gmapM,
- gmapF,
+ gmapMp,
+ gmapMo,
- -- * Generic unfolding defined in terms of gfoldl and fromConstr
- gunfoldM -- :: Monad m => ... -> m a
+ -- * Generic operation(s) defined in terms of gunfold
+ fromConstr, -- :: Constr -> a
+ fromConstrB, -- :: ... -> Constr -> a
+ fromConstrM -- :: Monad m => ... -> Constr -> m a
) where
------------------------------------------------------------------------------
+import Prelude -- necessary to get dependencies right
import Data.Typeable
import Data.Maybe
import Control.Monad
+
------------------------------------------------------------------------------
--
-- The Data class
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
--
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.
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
{-
-The combinators gmapT, gmapQ, gmapL, gmapM, gmapF can all be defined
-in terms of gfoldl. We provide corresponding default definitions
-leaving open the opportunity to provide datatype-specific definitions.
+The combinators gmapT, gmapQ, gmapM, ... can all be defined in terms
+of gfoldl. We provide corresponding default definitions leaving open
+the opportunity to provide datatype-specific definitions.
(The inclusion of the gmap combinators as members of class Data allows
the programmer or the compiler to derive specialised, and maybe more
k (ID c) x = ID (c (f x))
- -- | A generic query with monoid-like operators
- gmapQ :: (r -> r -> r) -> r -> (forall a. Data a => a -> r) -> a -> r
- gmapQ o r f = unCONST . gfoldl k z
+ -- | A generic query with a left-associative binary operator
+ gmapQl :: (r -> r' -> r) -> r -> (forall a. Data a => a -> r') -> a -> r
+ gmapQl o r f = unCONST . gfoldl k z
where
k c x = CONST $ (unCONST c) `o` f x
z _ = CONST r
+{-
+
+In the definition of gmapQ? combinators, we use phantom type
+constructors for the "c" in the type of "gfoldl" because the result
+type of a query does not involve the (polymorphic) type of the term
+argument. In the definition of gmapQl we simply use the plain constant
+type constructor because gfoldl is left-associative anyway and so it
+is readily suited to fold a left-associative binary operation over the
+immediate subterms. In the definition of gmapQr, extra effort is
+needed. We use a higher-order accumulation trick to mediate between
+left-associative constructor application vs. right-associative binary
+operation (e.g., (:)). When the query is meant to compute a value of
+type r, then the result type withing generic folding is r -> r. So the
+result of folding is a function to which we finally pass the right
+unit.
+
+-}
+
+ -- | A generic query with a right-associative binary operator
+ gmapQr :: (r' -> r -> r) -> r -> (forall a. Data a => a -> r') -> a -> r
+ gmapQr o r f x = unQr (gfoldl k (const (Qr id)) x) r
+ where
+ k (Qr c) x = Qr (\r -> c (f x `o` r))
+
-- | A generic query that processes the immediate subterms and returns a list
- gmapL :: (forall a. Data a => a -> u) -> a -> [u]
+ gmapQ :: (forall a. Data a => a -> u) -> a -> [u]
+ gmapQ f = gmapQr (:) [] f
- -- Use a phantom + function datatype constructor QL (see below),
- -- to instantiate the type constructor c in the type of gfoldl,
- -- and perform injections QL and projections unQL accordingly.
- --
- gmapL f x = unQL (gfoldl k (const (QL id)) x) []
+
+ -- | A generic query 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 (QL c) x = QL (\rs -> c (f x : rs))
+ 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
-- | Transformation of at least one immediate subterm does not fail
- gmapF :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
+ gmapMp :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
- -- Use a datatype constructor F (see below)
- -- to instantiate the type constructor c in the type of gfoldl.
- --
- gmapF f x = unFAIL (gfoldl k z x) >>= \(x',b) ->
- if b then return x' else mzero
+{-
+
+The type constructor that we use here simply keeps track of the fact
+if we already succeeded for an immediate subterm; see Mp below. To
+this end, we couple the monadic computation with a Boolean.
+
+-}
+
+ gmapMp f x = unMp (gfoldl k z x) >>= \(x',b) ->
+ if b then return x' else mzero
where
- z g = FAIL (return (g,False))
- k (FAIL c) x
- = FAIL ( c >>= \(h,b) ->
+ z g = Mp (return (g,False))
+ k (Mp c) x
+ = Mp ( c >>= \(h,b) ->
(f x >>= \x' -> return (h x',True))
- `mplus` return (h x, b)
- )
+ `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
newtype ID x = ID { unID :: x }
--- | The constant type constructor needed for the definition of gmapQ
+-- | The constant type constructor needed for the definition of gmapQl
newtype CONST c a = CONST { unCONST :: c }
--- | A phantom datatype constructor used in definition of gmapL;
--- the function-typed component is needed to mediate between
--- left-associative constructor application vs. right-associative lists.
---
-newtype QL r a = QL { unQL :: [r] -> [r] }
+-- | 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 }
--- | A pairing type constructor needed for the definition of gmapF;
--- we keep track of the fact if a subterm was ever transformed successfully.
-newtype FAIL m x = FAIL { unFAIL :: m (x, Bool) }
+-- | The type constructor used in definition of gmapMp
+newtype Mp m x = Mp { unMp :: m (x, Bool) }
------------------------------------------------------------------------------
--
--- 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
-- | Fixity of constructors
-data Fixity = NoFixity
- | PreFixity
- | InFixity
- deriving (Eq,Show)
+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
-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 (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"
+
+
+-- | Gets the maximum constructor index
+maxConstrIndex :: DataType -> ConIndex
+maxConstrIndex dt = case dataTypeRep dt of
+ AlgRep cs -> length cs
+ _ -> error "maxConstrIndex"
--- | Return all constructors in increasing order of indicies;
--- empty list for primitive types
-dataTypeCons :: DataType -> [Constr]
-dataTypeCons (DataType cs) = cs
-dataTypeCons _ = [] -- otherwise
------------------------------------------------------------------------------
--
--- 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" NoFixity
-trueConstr = mkConstr 2 "True" NoFixity
-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 "[]" NoFixity
-consConstr = mkConstr 2 "(:)" InFixity
-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)
- gmapL f [] = []
- gmapL f (x:xs) = [f x,f xs]
- gmapM f [] = return []
- gmapM f (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
+-- 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" NoFixity
-justConstr = mkConstr 2 "Just" NoFixity
-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 "(,)" InFixity
-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')
projects / ghc-base.git / blobdiff