-- 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.
--
-----------------------------------------------------------------------------
-- * Constructor representations
Constr, -- abstract, instance of: Eq, Show
ConIndex, -- alias for Int, start at 1
- Fixity, -- instance of: Eq, Show
+ Fixity(..), -- instance of: Eq, Show
DataType, -- abstract, instance of: Show
-- * Constructing constructor representations
-- * Generic maps defined in terms of gfoldl
gmapT,
gmapQ,
- gmapL,
+ gmapQl,
+ gmapQr,
gmapM,
- gmapF,
-
- -- * Generic unfolding defined in terms of gfoldl and fromConstr
- gunfoldM -- :: Monad m => ... -> m a
+ gmapMp,
+ gmapMo,
) where
{-
-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
+{-
- -- | A generic query that processes the immediate subterms and returns a list
- gmapL :: (forall a. Data a => a -> u) -> a -> [u]
+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.
- -- 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 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 (QL c) x = QL (\rs -> c (f x : rs))
+ 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 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] }
+-- | 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) }
-- | 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.
-- | Make a representation for a datatype constructor
mkConstr :: ConIndex -> String -> Fixity -> Constr
+-- ToDo: consider adding arity?
mkConstr = DataConstr
-- | Make a package of constructor representations
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'
-- define top-level definitions for representations.
--
-falseConstr = mkConstr 1 "False" NoFixity
-trueConstr = mkConstr 2 "True" NoFixity
+falseConstr = mkConstr 1 "False" Prefix
+trueConstr = mkConstr 2 "True" Prefix
boolDataType = mkDataType [falseConstr,trueConstr]
instance Data Bool where
-- Cons-lists are terms with two immediate subterms.
--
-nilConstr = mkConstr 1 "[]" NoFixity
-consConstr = mkConstr 2 "(:)" InFixity
+nilConstr = mkConstr 1 "[]" Prefix
+consConstr = mkConstr 2 "(:)" Infix
listDataType = mkDataType [nilConstr,consConstr]
instance Data a => Data [a] where
--
gmapT f [] = []
gmapT f (x:xs) = (f x:f xs)
- gmapL f [] = []
- gmapL 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')
-- No surprises.
--
-nothingConstr = mkConstr 1 "Nothing" NoFixity
-justConstr = mkConstr 2 "Just" NoFixity
+nothingConstr = mkConstr 1 "Nothing" Prefix
+justConstr = mkConstr 2 "Just" Prefix
maybeDataType = mkDataType [nothingConstr,justConstr]
instance Data a => Data (Maybe a) where
-- No surprises.
--
-pairConstr = mkConstr 1 "(,)" InFixity
+pairConstr = mkConstr 1 "(,)" Infix
productDataType = mkDataType [pairConstr]
instance (Data a, Data b) => Data (a,b) where
1 -> (undefined,undefined)
dataTypeOf _ = productDataType
+--
+-- Yet another polymorphic datatype constructor.
+-- No surprises.
+--
+
+
+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
+
{-
toConstr _ = FunConstr
fromConstr _ = undefined
dataTypeOf _ = FunType
-
-
-------------------------------------------------------------------------------
---
--- Generic unfolding
---
-------------------------------------------------------------------------------
-
--- | Construct an initial with undefined immediate subterms
--- and then map over the skeleton to fill in proper terms.
---
-gunfoldM :: (Monad m, Data a)
- => Constr
- -> (forall a. Data a => m a)
- -> m a
-gunfoldM c f = gmapM (const f) $ fromConstr c
projects / haskell-directory.git / blobdiff