import Prelude
import Data.Typeable
-#ifdef __GLASGOW_HASKELL__
-import Data.Generics.Basics( Data )
-#endif
#ifdef __HUGS__
import Hugs.Prelude(Num(fromInt), Fractional(fromDouble))
data (RealFloat a) => Complex a
= !a :+ !a -- ^ forms a complex number from its real and imaginary
-- rectangular components.
-# if __GLASGOW_HASKELL__
- deriving (Eq, Show, Read, Data)
-# else
deriving (Eq, Show, Read)
-# endif
-- -----------------------------------------------------------------------------
-- Functions over Complex
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : Data.Generics
--- 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 (uses Data.Generics.Basics)
---
--- \"Scrap your boilerplate\" --- Generic programming in Haskell
--- See <http://www.cs.vu.nl/boilerplate/>. To scrap your boilerplate it
--- is sufficient to import the present module, which simply re-exports all
--- themes of the Data.Generics library.
---
------------------------------------------------------------------------------
-
-module Data.Generics (
-
- -- * All Data.Generics modules
- module Data.Generics.Basics, -- primitives
- module Data.Generics.Instances, -- instances of Data class
- module Data.Generics.Aliases, -- aliases for type case, generic types
- module Data.Generics.Schemes, -- traversal schemes (everywhere etc.)
- module Data.Generics.Text, -- generic read and show
- module Data.Generics.Twins, -- twin traversal, e.g., generic eq
-
-#ifndef __HADDOCK__
- -- Data types for the sum-of-products type encoding;
- -- included for backwards compatibility; maybe obsolete.
- (:*:)(..), (:+:)(..), Unit(..)
-#endif
-
- ) where
-
-------------------------------------------------------------------------------
-
-import Prelude -- So that 'make depend' works
-
-#ifdef __GLASGOW_HASKELL__
-#ifndef __HADDOCK__
- -- Data types for the sum-of-products type encoding;
- -- included for backwards compatibility; maybe obsolete.
-import GHC.Base ( (:*:)(..), (:+:)(..), Unit(..) )
-#endif
-#endif
-
-import Data.Generics.Basics
-import Data.Generics.Instances
-import Data.Generics.Aliases
-import Data.Generics.Schemes
-import Data.Generics.Text
-import Data.Generics.Twins
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : Data.Generics.Aliases
--- 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 (local universal quantification)
---
--- \"Scrap your boilerplate\" --- Generic programming in Haskell
--- See <http://www.cs.vu.nl/boilerplate/>. The present module provides
--- a number of declarations for typical generic function types,
--- corresponding type case, and others.
---
------------------------------------------------------------------------------
-
-module Data.Generics.Aliases (
-
- -- * Combinators to \"make\" generic functions via cast
- mkT, mkQ, mkM, mkMp, mkR,
- ext0, extT, extQ, extM, extMp, extB, extR,
-
- -- * Type synonyms for generic function types
- GenericT,
- GenericQ,
- GenericM,
- GenericB,
- GenericR,
- Generic,
- Generic'(..),
- GenericT'(..),
- GenericQ'(..),
- GenericM'(..),
-
- -- * Inredients of generic functions
- orElse,
-
- -- * Function combinators on generic functions
- recoverMp,
- recoverQ,
- choiceMp,
- choiceQ,
-
- -- * Type extension for unary type constructors
- ext1T,
- ext1M,
- ext1Q,
- ext1R
-
- ) where
-
-#ifdef __HADDOCK__
-import Prelude
-#endif
-import Control.Monad
-import Data.Generics.Basics
-
-------------------------------------------------------------------------------
---
--- Combinators to "make" generic functions
--- We use type-safe cast in a number of ways to make generic functions.
---
-------------------------------------------------------------------------------
-
--- | Make a generic transformation;
--- start from a type-specific case;
--- preserve the term otherwise
---
-mkT :: ( Typeable a
- , Typeable b
- )
- => (b -> b)
- -> a
- -> a
-mkT = extT id
-
-
--- | Make a generic query;
--- start from a type-specific case;
--- return a constant otherwise
---
-mkQ :: ( Typeable a
- , Typeable b
- )
- => r
- -> (b -> r)
- -> a
- -> r
-(r `mkQ` br) a = case cast a of
- Just b -> br b
- Nothing -> r
-
-
--- | Make a generic monadic transformation;
--- start from a type-specific case;
--- resort to return otherwise
---
-mkM :: ( Monad m
- , Typeable a
- , Typeable b
- )
- => (b -> m b)
- -> a
- -> m a
-mkM = extM return
-
-
-{-
-
-For the remaining definitions, we stick to a more concise style, i.e.,
-we fold maybies with "maybe" instead of case ... of ..., and we also
-use a point-free style whenever possible.
-
--}
-
-
--- | Make a generic monadic transformation for MonadPlus;
--- use \"const mzero\" (i.e., failure) instead of return as default.
---
-mkMp :: ( MonadPlus m
- , Typeable a
- , Typeable b
- )
- => (b -> m b)
- -> a
- -> m a
-mkMp = extM (const mzero)
-
-
--- | Make a generic builder;
--- start from a type-specific ase;
--- resort to no build (i.e., mzero) otherwise
---
-mkR :: ( MonadPlus m
- , Typeable a
- , Typeable b
- )
- => m b -> m a
-mkR f = mzero `extR` f
-
-
--- | Flexible type extension
-ext0 :: (Typeable a, Typeable b) => c a -> c b -> c a
-ext0 def ext = maybe def id (gcast ext)
-
-
--- | Extend a generic transformation by a type-specific case
-extT :: ( Typeable a
- , Typeable b
- )
- => (a -> a)
- -> (b -> b)
- -> a
- -> a
-extT def ext = unT ((T def) `ext0` (T ext))
-
-
--- | Extend a generic query by a type-specific case
-extQ :: ( Typeable a
- , Typeable b
- )
- => (a -> q)
- -> (b -> q)
- -> a
- -> q
-extQ f g a = maybe (f a) g (cast a)
-
-
--- | Extend a generic monadic transformation by a type-specific case
-extM :: ( Monad m
- , Typeable a
- , Typeable b
- )
- => (a -> m a) -> (b -> m b) -> a -> m a
-extM def ext = unM ((M def) `ext0` (M ext))
-
-
--- | Extend a generic MonadPlus transformation by a type-specific case
-extMp :: ( MonadPlus m
- , Typeable a
- , Typeable b
- )
- => (a -> m a) -> (b -> m b) -> a -> m a
-extMp = extM
-
-
--- | Extend a generic builder
-extB :: ( Typeable a
- , Typeable b
- )
- => a -> b -> a
-extB a = maybe a id . cast
-
-
--- | Extend a generic reader
-extR :: ( Monad m
- , Typeable a
- , Typeable b
- )
- => m a -> m b -> m a
-extR def ext = unR ((R def) `ext0` (R ext))
-
-
-
-------------------------------------------------------------------------------
---
--- Type synonyms for generic function types
---
-------------------------------------------------------------------------------
-
-
--- | Generic transformations,
--- i.e., take an \"a\" and return an \"a\"
---
-type GenericT = forall a. Data a => a -> a
-
-
--- | Generic queries of type \"r\",
--- i.e., take any \"a\" and return an \"r\"
---
-type GenericQ r = forall a. Data a => a -> r
-
-
--- | Generic monadic transformations,
--- i.e., take an \"a\" and compute an \"a\"
---
-type GenericM m = forall a. Data a => a -> m a
-
-
--- | Generic builders
--- i.e., produce an \"a\".
---
-type GenericB = forall a. Data a => a
-
-
--- | Generic readers, say monadic builders,
--- i.e., produce an \"a\" with the help of a monad \"m\".
---
-type GenericR m = forall a. Data a => m a
-
-
--- | The general scheme underlying generic functions
--- assumed by gfoldl; there are isomorphisms such as
--- GenericT = Generic T.
---
-type Generic c = forall a. Data a => a -> c a
-
-
--- | Wrapped generic functions;
--- recall: [Generic c] would be legal but [Generic' c] not.
---
-data Generic' c = Generic' { unGeneric' :: Generic c }
-
-
--- | Other first-class polymorphic wrappers
-newtype GenericT' = GT { unGT :: Data a => a -> a }
-newtype GenericQ' r = GQ { unGQ :: GenericQ r }
-newtype GenericM' m = GM { unGM :: Data a => a -> m a }
-
-
--- | Left-biased choice on maybies
-orElse :: Maybe a -> Maybe a -> Maybe a
-x `orElse` y = case x of
- Just _ -> x
- Nothing -> y
-
-
-{-
-
-The following variations take "orElse" to the function
-level. Furthermore, we generalise from "Maybe" to any
-"MonadPlus". This makes sense for monadic transformations and
-queries. We say that the resulting combinators modell choice. We also
-provide a prime example of choice, that is, recovery from failure. In
-the case of transformations, we recover via return whereas for
-queries a given constant is returned.
-
--}
-
--- | Choice for monadic transformations
-choiceMp :: MonadPlus m => GenericM m -> GenericM m -> GenericM m
-choiceMp f g x = f x `mplus` g x
-
-
--- | Choice for monadic queries
-choiceQ :: MonadPlus m => GenericQ (m r) -> GenericQ (m r) -> GenericQ (m r)
-choiceQ f g x = f x `mplus` g x
-
-
--- | Recover from the failure of monadic transformation by identity
-recoverMp :: MonadPlus m => GenericM m -> GenericM m
-recoverMp f = f `choiceMp` return
-
-
--- | Recover from the failure of monadic query by a constant
-recoverQ :: MonadPlus m => r -> GenericQ (m r) -> GenericQ (m r)
-recoverQ r f = f `choiceQ` const (return r)
-
-
-
-------------------------------------------------------------------------------
---
--- Type extension for unary type constructors
---
-------------------------------------------------------------------------------
-
-
-
--- | Flexible type extension
-ext1 :: (Data a, Typeable1 t)
- => c a
- -> (forall d. Data d => c (t d))
- -> c a
-ext1 def ext = maybe def id (dataCast1 ext)
-
-
--- | Type extension of transformations for unary type constructors
-ext1T :: (Data d, Typeable1 t)
- => (forall e. Data e => e -> e)
- -> (forall f. Data f => t f -> t f)
- -> d -> d
-ext1T def ext = unT ((T def) `ext1` (T ext))
-
-
--- | Type extension of monadic transformations for type constructors
-ext1M :: (Monad m, Data d, Typeable1 t)
- => (forall e. Data e => e -> m e)
- -> (forall f. Data f => t f -> m (t f))
- -> d -> m d
-ext1M def ext = unM ((M def) `ext1` (M ext))
-
-
--- | Type extension of queries for type constructors
-ext1Q :: (Data d, Typeable1 t)
- => (d -> q)
- -> (forall e. Data e => t e -> q)
- -> d -> q
-ext1Q def ext = unQ ((Q def) `ext1` (Q ext))
-
-
--- | Type extension of readers for type constructors
-ext1R :: (Monad m, Data d, Typeable1 t)
- => m d
- -> (forall e. Data e => m (t e))
- -> m d
-ext1R def ext = unR ((R def) `ext1` (R ext))
-
-
-
-------------------------------------------------------------------------------
---
--- Type constructors for type-level lambdas
---
-------------------------------------------------------------------------------
-
-
--- | The type constructor for transformations
-newtype T x = T { unT :: x -> x }
-
--- | The type constructor for transformations
-newtype M m x = M { unM :: x -> m x }
-
--- | The type constructor for queries
-newtype Q q x = Q { unQ :: x -> q }
-
--- | The type constructor for readers
-newtype R m x = R { unR :: m x }
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : Data.Generics.Basics
--- 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 (local universal quantification)
---
--- \"Scrap your boilerplate\" --- Generic programming in Haskell.
--- See <http://www.cs.vu.nl/boilerplate/>. This 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,
-
- -- * The Data class for processing constructor applications
- Data(
- gfoldl, -- :: ... -> a -> c a
- gunfold, -- :: ... -> Constr -> c a
- toConstr, -- :: a -> Constr
- dataTypeOf, -- :: a -> DataType
- dataCast1, -- mediate types and unary type constructors
- dataCast2, -- mediate types and binary type constructors
- -- Generic maps defined in terms of gfoldl
- gmapT,
- gmapQ,
- gmapQl,
- gmapQr,
- gmapQi,
- gmapM,
- gmapMp,
- gmapMo
- ),
-
- -- * Datatype representations
- DataType, -- abstract, instance of: Show
- -- ** Constructors
- mkDataType, -- :: String -> [Constr] -> DataType
- mkIntType, -- :: String -> DataType
- mkFloatType, -- :: String -> DataType
- mkStringType, -- :: String -> DataType
- mkNorepType, -- :: String -> DataType
- -- ** Observers
- dataTypeName, -- :: DataType -> String
- DataRep(..), -- instance of: Eq, Show
- dataTypeRep, -- :: DataType -> DataRep
- -- ** Convenience functions
- repConstr, -- :: DataType -> ConstrRep -> Constr
- isAlgType, -- :: DataType -> Bool
- dataTypeConstrs,-- :: DataType -> [Constr]
- indexConstr, -- :: DataType -> ConIndex -> Constr
- maxConstrIndex, -- :: DataType -> ConIndex
- isNorepType, -- :: DataType -> Bool
-
- -- * Data constructor representations
- Constr, -- abstract, instance of: Eq, Show
- ConIndex, -- alias for Int, start at 1
- Fixity(..), -- instance of: Eq, Show
- -- ** Constructors
- mkConstr, -- :: DataType -> String -> Fixity -> Constr
- mkIntConstr, -- :: DataType -> Integer -> Constr
- mkFloatConstr, -- :: DataType -> Double -> Constr
- mkStringConstr, -- :: DataType -> String -> Constr
- -- ** Observers
- constrType, -- :: Constr -> DataType
- ConstrRep(..), -- instance of: Eq, Show
- constrRep, -- :: Constr -> ConstrRep
- constrFields, -- :: Constr -> [String]
- constrFixity, -- :: Constr -> Fixity
- -- ** Convenience function: algebraic data types
- constrIndex, -- :: Constr -> ConIndex
- -- ** From strings to constructors and vice versa: all data types
- showConstr, -- :: Constr -> String
- readConstr, -- :: DataType -> String -> Maybe Constr
-
- -- * Convenience functions: take type constructors apart
- tyconUQname, -- :: String -> String
- tyconModule, -- :: String -> String
-
- -- * Generic operations 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
---
-------------------------------------------------------------------------------
-
-{- |
-The 'Data' class comprehends a fundamental primitive 'gfoldl' for
-folding over constructor applications, say terms. This primitive can
-be instantiated in several ways to map over the immediate subterms
-of a term; see the @gmap@ combinators later in this class. Indeed, a
-generic programmer does not necessarily need to use the ingenious gfoldl
-primitive but rather the intuitive @gmap@ combinators. The 'gfoldl'
-primitive is completed by means to query top-level constructors, to
-turn constructor representations into proper terms, and to list all
-possible datatype constructors. This completion allows us to serve
-generic programming scenarios like read, show, equality, term generation.
-
-The combinators 'gmapT', 'gmapQ', 'gmapM', etc are all provided with
-default definitions in terms of 'gfoldl', 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 efficient code per datatype. /Note/: 'gfoldl' is more higher-order
-than the @gmap@ combinators. This is subject to ongoing benchmarking
-experiments. It might turn out that the @gmap@ combinators will be
-moved out of the class 'Data'.)
-
-Conceptually, the definition of the @gmap@ combinators in terms of the
-primitive 'gfoldl' requires the identification of the 'gfoldl' function
-arguments. Technically, we also need to identify the type constructor
-@c@ for the construction of the result type from the folded term type.
-
-In the definition of @gmapQ@/x/ 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.
-
-With the @-XDeriveDataTypeable@ option, GHC can generate instances of the
-'Data' class automatically. For example, given the declaration
-
-> data T a b = C1 a b | C2 deriving (Typeable, Data)
-
-GHC will generate an instance that is equivalent to
-
-> instance (Data a, Data b) => Data (T a b) where
-> gfoldl k z (C1 a b) = z C1 `k` a `k` b
-> gfoldl k z C2 = z C2
->
-> gunfold k z c = case constrIndex c of
-> 1 -> k (k (z C1))
-> 2 -> z C2
->
-> toConstr (C1 _ _) = con_C1
-> toConstr C2 = con_C2
->
-> dataTypeOf _ = ty_T
->
-> con_C1 = mkConstr ty_T "C1" [] Prefix
-> con_C2 = mkConstr ty_T "C2" [] Prefix
-> ty_T = mkDataType "Module.T" [con_C1, con_C2]
-
-This is suitable for datatypes that are exported transparently.
-
--}
-
-class Typeable a => Data a where
-
- -- | Left-associative fold operation for constructor applications.
- --
- -- The type of 'gfoldl' is a headache, but operationally it is a simple
- -- generalisation of a list fold.
- --
- -- The default definition for 'gfoldl' is @'const' 'id'@, which is
- -- suitable for abstract datatypes with no substructures.
- gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
- -- ^ defines how nonempty constructor applications are
- -- folded. It takes the folded tail of the constructor
- -- application and its head, i.e., an immediate subterm,
- -- and combines them in some way.
- -> (forall g. g -> c g)
- -- ^ defines how the empty constructor application is
- -- folded, like the neutral \/ start element for list
- -- folding.
- -> a
- -- ^ structure to be folded.
- -> c a
- -- ^ result, with a type defined in terms of @a@, but
- -- variability is achieved by means of type constructor
- -- @c@ for the construction of the actual result type.
-
- -- See the 'Data' instances in this file for an illustration of 'gfoldl'.
-
- 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
- -- values (i.e., constructors).
- toConstr :: a -> Constr
-
-
- -- | The outer type constructor of the type
- dataTypeOf :: a -> DataType
-
-
-
-------------------------------------------------------------------------------
---
--- Mediate types and type constructors
---
-------------------------------------------------------------------------------
-
- -- | Mediate types and unary type constructors.
- -- In 'Data' instances of the form @T a@, 'dataCast1' should be defined
- -- as 'gcast1'.
- --
- -- The default definition is @'const' 'Nothing'@, which is appropriate
- -- for non-unary type constructors.
- dataCast1 :: Typeable1 t
- => (forall d. Data d => c (t d))
- -> Maybe (c a)
- dataCast1 _ = Nothing
-
- -- | Mediate types and binary type constructors.
- -- In 'Data' instances of the form @T a b@, 'dataCast2' should be
- -- defined as 'gcast2'.
- --
- -- The default definition is @'const' 'Nothing'@, which is appropriate
- -- for non-binary type constructors.
- dataCast2 :: Typeable2 t
- => (forall d e. (Data d, Data e) => c (t d e))
- -> Maybe (c a)
- dataCast2 _ = Nothing
-
-
-
-------------------------------------------------------------------------------
---
--- Typical generic maps defined in terms of gfoldl
---
-------------------------------------------------------------------------------
-
-
- -- | A generic transformation that maps over the immediate subterms
- --
- -- The default definition instantiates the type constructor @c@ in the
- -- type of 'gfoldl' to an identity datatype constructor, using the
- -- isomorphism pair as injection and projection.
- gmapT :: (forall b. Data b => b -> b) -> a -> a
-
- -- Use an identity datatype constructor ID (see below)
- -- to instantiate the type constructor c in the type of gfoldl,
- -- and perform injections ID and projections unID accordingly.
- --
- gmapT f x0 = unID (gfoldl k ID x0)
- where
- k (ID c) x = ID (c (f x))
-
-
- -- | A generic query with a left-associative binary operator
- gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> 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 with a right-associative binary operator
- gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
- gmapQr o r0 f x0 = unQr (gfoldl k (const (Qr id)) x0) r0
- where
- k (Qr c) x = Qr (\r -> c (f x `o` r))
-
-
- -- | A generic query that processes the immediate subterms and returns a list
- -- of results. The list is given in the same order as originally specified
- -- in the declaratoin of the data constructors.
- gmapQ :: (forall d. Data d => d -> u) -> a -> [u]
- gmapQ f = gmapQr (:) [] f
-
-
- -- | A generic query that processes one child by index (zero-based)
- gmapQi :: Int -> (forall d. Data d => d -> 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 _ = Qi 0 Nothing
-
-
- -- | A generic monadic transformation that maps over the immediate subterms
- --
- -- The default definition instantiates the type constructor @c@ in
- -- the type of 'gfoldl' to the monad datatype constructor, defining
- -- injection and projection using 'return' and '>>='.
- gmapM :: Monad m => (forall d. Data d => d -> m d) -> a -> m a
-
- -- Use immediately the monad datatype constructor
- -- to instantiate the type constructor c in the type of gfoldl,
- -- so injection and projection is done by return and >>=.
- --
- gmapM f = gfoldl k return
- where
- k c x = do c' <- c
- x' <- f x
- return (c' x')
-
-
- -- | Transformation of at least one immediate subterm does not fail
- gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
-
-{-
-
-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 = Mp (return (g,False))
- k (Mp c) y
- = Mp ( c >>= \(h, b) ->
- (f y >>= \y' -> return (h y', True))
- `mplus` return (h y, b)
- )
-
- -- | Transformation of one immediate subterm with success
- gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> 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) y
- = Mp ( c >>= \(h,b) -> if b
- then return (h y, b)
- else (f y >>= \y' -> return (h y',True))
- `mplus` return (h y, 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 gmapQl
-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 }
-
-
--- | The type constructor used in definition of gmapMp
-newtype Mp m x = Mp { unMp :: m (x, Bool) }
-
-
-
-------------------------------------------------------------------------------
---
--- Generic unfolding
---
-------------------------------------------------------------------------------
-
-
--- | Build a term skeleton
-fromConstr :: Data a => Constr -> a
-fromConstr = fromConstrB undefined
-
-
--- | Build a term and use a generic function for subterms
-fromConstrB :: Data a
- => (forall d. Data d => d)
- -> Constr
- -> a
-fromConstrB f = unID . gunfold k z
- where
- k c = ID (unID c f)
- z = ID
-
-
--- | Monadic variation on 'fromConstrB'
-fromConstrM :: (Monad m, Data a)
- => (forall d. Data d => m d)
- -> Constr
- -> m a
-fromConstrM f = gunfold k z
- where
- k c = do { c' <- c; b <- f; return (c' b) }
- z = return
-
-
-
-------------------------------------------------------------------------------
---
--- Datatype and constructor representations
---
-------------------------------------------------------------------------------
-
-
---
--- | Representation of datatypes.
--- A package of constructor representations with names of type and module.
---
-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
- c == c' = constrRep c == constrRep c'
-
-
--- | Public representation of datatypes
-data DataRep = AlgRep [Constr]
- | IntRep
- | FloatRep
- | StringRep
- | NoRep
-
- deriving (Eq,Show)
--- The list of constructors could be an array, a balanced tree, or others.
-
-
--- | Public representation of constructors
-data ConstrRep = AlgConstr ConIndex
- | IntConstr Integer
- | FloatConstr Double
- | StringConstr String
-
- deriving (Eq,Show)
-
-
--- | Unique index for datatype constructors,
--- counting from 1 in the order they are given in the program text.
-type ConIndex = Int
-
-
--- | Fixity of constructors
-data Fixity = Prefix
- | Infix -- Later: add associativity and precedence
-
- deriving (Eq,Show)
-
-
-------------------------------------------------------------------------------
---
--- Observers for datatype representations
---
-------------------------------------------------------------------------------
-
-
--- | Gets the type constructor including the module
-dataTypeName :: DataType -> String
-dataTypeName = tycon
-
-
-
--- | Gets the public presentation of a datatype
-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"
-
-
-
-------------------------------------------------------------------------------
---
--- Representations of algebraic data types
---
-------------------------------------------------------------------------------
-
-
--- | 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 of an algebraic datatype
-dataTypeConstrs :: DataType -> [Constr]
-dataTypeConstrs dt = case datarep dt of
- (AlgRep cons) -> cons
- _ -> error "dataTypeConstrs"
-
-
--- | Gets the field labels of a constructor. The list of labels
--- is returned in the same order as they were given in the original
--- constructor declaration.
-constrFields :: Constr -> [String]
-constrFields = confields
-
-
--- | Gets the fixity of a constructor
-constrFixity :: Constr -> Fixity
-constrFixity = confixity
-
-
-
-------------------------------------------------------------------------------
---
--- From strings to constr's and vice versa: all data types
---
-------------------------------------------------------------------------------
-
-
--- | Gets the string for a constructor
-showConstr :: Constr -> String
-showConstr = constring
-
-
--- | 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)
-
-
-------------------------------------------------------------------------------
---
--- Convenience funtions: algebraic data types
---
-------------------------------------------------------------------------------
-
-
--- | Test for an algebraic type
-isAlgType :: DataType -> Bool
-isAlgType dt = case datarep dt of
- (AlgRep _) -> True
- _ -> False
-
-
--- | Gets the constructor for an index (algebraic datatypes only)
-indexConstr :: DataType -> ConIndex -> Constr
-indexConstr dt idx = case datarep dt of
- (AlgRep cs) -> cs !! (idx-1)
- _ -> error "indexConstr"
-
-
--- | Gets the index of a constructor (algebraic datatypes only)
-constrIndex :: Constr -> ConIndex
-constrIndex con = case constrRep con of
- (AlgConstr idx) -> idx
- _ -> error "constrIndex"
-
-
--- | Gets the maximum constructor index of an algebraic datatype
-maxConstrIndex :: DataType -> ConIndex
-maxConstrIndex dt = case dataTypeRep dt of
- AlgRep cs -> length cs
- _ -> error "maxConstrIndex"
-
-
-
-------------------------------------------------------------------------------
---
--- Representation of primitive types
---
-------------------------------------------------------------------------------
-
-
--- | Constructs the 'Int' type
-mkIntType :: String -> DataType
-mkIntType = mkPrimType IntRep
-
-
--- | Constructs the 'Float' type
-mkFloatType :: String -> DataType
-mkFloatType = mkPrimType FloatRep
-
-
--- | Constructs the 'String' type
-mkStringType :: String -> DataType
-mkStringType = mkPrimType StringRep
-
-
--- | 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"
-
-
-------------------------------------------------------------------------------
---
--- Non-representations for non-presentable types
---
-------------------------------------------------------------------------------
-
-
--- | Constructs a non-representation for a non-presentable type
-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
-
-
-
-------------------------------------------------------------------------------
---
--- 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' y = let y' = tyconModule y
- in if y' == "" then "" else ('.':y')
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : Data.Generics.Instances
--- 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 (uses Data.Generics.Basics)
---
--- \"Scrap your boilerplate\" --- Generic programming in Haskell
--- See <http://www.cs.vu.nl/boilerplate/>. The present module
--- instantiates the class Data for Prelude-like datatypes.
--- (This module does not export anything. It really just defines instances.)
---
------------------------------------------------------------------------------
-
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-module Data.Generics.Instances where
-
-
-------------------------------------------------------------------------------
-
-#ifdef __HADDOCK__
-import Prelude
-#endif
-
-import Data.Generics.Basics
-
-import Data.Typeable
-import Data.Int -- So we can give Data instance for Int8, ...
-import Data.Word -- So we can give Data instance for Word8, ...
-import GHC.Real( Ratio(..) ) -- So we can give Data instance for Ratio
-import GHC.IOBase -- So we can give Data instance for IO, Handle
-import GHC.Ptr -- So we can give Data instance for Ptr
-import GHC.ForeignPtr -- So we can give Data instance for ForeignPtr
-import GHC.Stable -- So we can give Data instance for StablePtr
-import GHC.ST -- So we can give Data instance for ST
-import GHC.Conc -- So we can give Data instance for MVar & Co.
-import GHC.Arr -- So we can give Data instance for Array
-
-#include "Typeable.h"
-
-
-------------------------------------------------------------------------------
---
--- Instances of the Data class for Prelude-like types.
--- We define top-level definitions for representations.
---
-------------------------------------------------------------------------------
-
-
-falseConstr :: Constr
-falseConstr = mkConstr boolDataType "False" [] Prefix
-trueConstr :: Constr
-trueConstr = mkConstr boolDataType "True" [] Prefix
-
-boolDataType :: DataType
-boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr]
-
-instance Data Bool where
- toConstr False = falseConstr
- toConstr True = trueConstr
- gunfold _ z c = case constrIndex c of
- 1 -> z False
- 2 -> z True
- _ -> error "gunfold"
- dataTypeOf _ = boolDataType
-
-
-------------------------------------------------------------------------------
-
-charType :: DataType
-charType = mkStringType "Prelude.Char"
-
-instance Data Char where
- toConstr x = mkStringConstr charType [x]
- gunfold _ z c = case constrRep c of
- (StringConstr [x]) -> z x
- _ -> error "gunfold"
- dataTypeOf _ = charType
-
-
-------------------------------------------------------------------------------
-
-floatType :: DataType
-floatType = mkFloatType "Prelude.Float"
-
-instance Data Float where
- toConstr x = mkFloatConstr floatType (realToFrac x)
- gunfold _ z c = case constrRep c of
- (FloatConstr x) -> z (realToFrac x)
- _ -> error "gunfold"
- dataTypeOf _ = floatType
-
-
-------------------------------------------------------------------------------
-
-doubleType :: DataType
-doubleType = mkFloatType "Prelude.Double"
-
-instance Data Double where
- toConstr = mkFloatConstr floatType
- gunfold _ z c = case constrRep c of
- (FloatConstr x) -> z x
- _ -> error "gunfold"
- dataTypeOf _ = doubleType
-
-
-------------------------------------------------------------------------------
-
-intType :: DataType
-intType = mkIntType "Prelude.Int"
-
-instance Data Int where
- toConstr x = mkIntConstr intType (fromIntegral x)
- gunfold _ z c = case constrRep c of
- (IntConstr x) -> z (fromIntegral x)
- _ -> error "gunfold"
- dataTypeOf _ = intType
-
-
-------------------------------------------------------------------------------
-
-integerType :: DataType
-integerType = mkIntType "Prelude.Integer"
-
-instance Data Integer where
- toConstr = mkIntConstr integerType
- gunfold _ z c = case constrRep c of
- (IntConstr x) -> z x
- _ -> error "gunfold"
- dataTypeOf _ = integerType
-
-
-------------------------------------------------------------------------------
-
-int8Type :: DataType
-int8Type = mkIntType "Data.Int.Int8"
-
-instance Data Int8 where
- toConstr x = mkIntConstr int8Type (fromIntegral x)
- gunfold _ z c = case constrRep c of
- (IntConstr x) -> z (fromIntegral x)
- _ -> error "gunfold"
- dataTypeOf _ = int8Type
-
-
-------------------------------------------------------------------------------
-
-int16Type :: DataType
-int16Type = mkIntType "Data.Int.Int16"
-
-instance Data Int16 where
- toConstr x = mkIntConstr int16Type (fromIntegral x)
- gunfold _ z c = case constrRep c of
- (IntConstr x) -> z (fromIntegral x)
- _ -> error "gunfold"
- dataTypeOf _ = int16Type
-
-
-------------------------------------------------------------------------------
-
-int32Type :: DataType
-int32Type = mkIntType "Data.Int.Int32"
-
-instance Data Int32 where
- toConstr x = mkIntConstr int32Type (fromIntegral x)
- gunfold _ z c = case constrRep c of
- (IntConstr x) -> z (fromIntegral x)
- _ -> error "gunfold"
- dataTypeOf _ = int32Type
-
-
-------------------------------------------------------------------------------
-
-int64Type :: DataType
-int64Type = mkIntType "Data.Int.Int64"
-
-instance Data Int64 where
- toConstr x = mkIntConstr int64Type (fromIntegral x)
- gunfold _ z c = case constrRep c of
- (IntConstr x) -> z (fromIntegral x)
- _ -> error "gunfold"
- dataTypeOf _ = int64Type
-
-
-------------------------------------------------------------------------------
-
-wordType :: DataType
-wordType = mkIntType "Data.Word.Word"
-
-instance Data Word where
- toConstr x = mkIntConstr wordType (fromIntegral x)
- gunfold _ z c = case constrRep c of
- (IntConstr x) -> z (fromIntegral x)
- _ -> error "gunfold"
- dataTypeOf _ = wordType
-
-
-------------------------------------------------------------------------------
-
-word8Type :: DataType
-word8Type = mkIntType "Data.Word.Word8"
-
-instance Data Word8 where
- toConstr x = mkIntConstr word8Type (fromIntegral x)
- gunfold _ z c = case constrRep c of
- (IntConstr x) -> z (fromIntegral x)
- _ -> error "gunfold"
- dataTypeOf _ = word8Type
-
-
-------------------------------------------------------------------------------
-
-word16Type :: DataType
-word16Type = mkIntType "Data.Word.Word16"
-
-instance Data Word16 where
- toConstr x = mkIntConstr word16Type (fromIntegral x)
- gunfold _ z c = case constrRep c of
- (IntConstr x) -> z (fromIntegral x)
- _ -> error "gunfold"
- dataTypeOf _ = word16Type
-
-
-------------------------------------------------------------------------------
-
-word32Type :: DataType
-word32Type = mkIntType "Data.Word.Word32"
-
-instance Data Word32 where
- toConstr x = mkIntConstr word32Type (fromIntegral x)
- gunfold _ z c = case constrRep c of
- (IntConstr x) -> z (fromIntegral x)
- _ -> error "gunfold"
- dataTypeOf _ = word32Type
-
-
-------------------------------------------------------------------------------
-
-word64Type :: DataType
-word64Type = mkIntType "Data.Word.Word64"
-
-instance Data Word64 where
- toConstr x = mkIntConstr word64Type (fromIntegral x)
- gunfold _ z c = case constrRep c of
- (IntConstr x) -> z (fromIntegral x)
- _ -> error "gunfold"
- dataTypeOf _ = word64Type
-
-
-------------------------------------------------------------------------------
-
-ratioConstr :: Constr
-ratioConstr = mkConstr ratioDataType ":%" [] Infix
-
-ratioDataType :: DataType
-ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr]
-
-instance (Data a, Integral a) => Data (Ratio a) where
- toConstr _ = ratioConstr
- gunfold k z c | constrIndex c == 1 = k (k (z (:%)))
- gunfold _ _ _ = error "gunfold"
- dataTypeOf _ = ratioDataType
-
-
-------------------------------------------------------------------------------
-
-nilConstr :: Constr
-nilConstr = mkConstr listDataType "[]" [] Prefix
-consConstr :: Constr
-consConstr = mkConstr listDataType "(:)" [] Infix
-
-listDataType :: DataType
-listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]
-
-instance Data a => Data [a] where
- gfoldl _ z [] = z []
- gfoldl f z (x:xs) = z (:) `f` x `f` xs
- toConstr [] = nilConstr
- toConstr (_:_) = consConstr
- gunfold k z c = case constrIndex c of
- 1 -> z []
- 2 -> k (k (z (:)))
- _ -> error "gunfold"
- dataTypeOf _ = listDataType
- dataCast1 f = gcast1 f
-
---
--- The gmaps are given as an illustration.
--- This shows that the gmaps for lists are different from list maps.
---
- gmapT _ [] = []
- gmapT f (x:xs) = (f x:f xs)
- gmapQ _ [] = []
- gmapQ f (x:xs) = [f x,f xs]
- gmapM _ [] = return []
- gmapM f (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
-
-
-------------------------------------------------------------------------------
-
-nothingConstr :: Constr
-nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix
-justConstr :: Constr
-justConstr = mkConstr maybeDataType "Just" [] Prefix
-
-maybeDataType :: DataType
-maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr]
-
-instance Data a => Data (Maybe a) where
- gfoldl _ z Nothing = z Nothing
- gfoldl f z (Just x) = z Just `f` x
- toConstr Nothing = nothingConstr
- toConstr (Just _) = justConstr
- gunfold k z c = case constrIndex c of
- 1 -> z Nothing
- 2 -> k (z Just)
- _ -> error "gunfold"
- dataTypeOf _ = maybeDataType
- dataCast1 f = gcast1 f
-
-
-------------------------------------------------------------------------------
-
-ltConstr :: Constr
-ltConstr = mkConstr orderingDataType "LT" [] Prefix
-eqConstr :: Constr
-eqConstr = mkConstr orderingDataType "EQ" [] Prefix
-gtConstr :: Constr
-gtConstr = mkConstr orderingDataType "GT" [] Prefix
-
-orderingDataType :: DataType
-orderingDataType = mkDataType "Prelude.Ordering" [ltConstr,eqConstr,gtConstr]
-
-instance Data Ordering where
- gfoldl _ z LT = z LT
- gfoldl _ z EQ = z EQ
- gfoldl _ z GT = z GT
- toConstr LT = ltConstr
- toConstr EQ = eqConstr
- toConstr GT = gtConstr
- gunfold _ z c = case constrIndex c of
- 1 -> z LT
- 2 -> z EQ
- 3 -> z GT
- _ -> error "gunfold"
- dataTypeOf _ = orderingDataType
-
-
-------------------------------------------------------------------------------
-
-leftConstr :: Constr
-leftConstr = mkConstr eitherDataType "Left" [] Prefix
-
-rightConstr :: Constr
-rightConstr = mkConstr eitherDataType "Right" [] Prefix
-
-eitherDataType :: DataType
-eitherDataType = mkDataType "Prelude.Either" [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
- gunfold k z c = case constrIndex c of
- 1 -> k (z Left)
- 2 -> k (z Right)
- _ -> error "gunfold"
- dataTypeOf _ = eitherDataType
- dataCast2 f = gcast2 f
-
-
-------------------------------------------------------------------------------
-
-
---
--- A last resort for functions
---
-
-instance (Data a, Data b) => Data (a -> b) where
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "Prelude.(->)"
- dataCast2 f = gcast2 f
-
-
-------------------------------------------------------------------------------
-
-tuple0Constr :: Constr
-tuple0Constr = mkConstr tuple0DataType "()" [] Prefix
-
-tuple0DataType :: DataType
-tuple0DataType = mkDataType "Prelude.()" [tuple0Constr]
-
-instance Data () where
- toConstr () = tuple0Constr
- gunfold _ z c | constrIndex c == 1 = z ()
- gunfold _ _ _ = error "gunfold"
- dataTypeOf _ = tuple0DataType
-
-
-------------------------------------------------------------------------------
-
-tuple2Constr :: Constr
-tuple2Constr = mkConstr tuple2DataType "(,)" [] Infix
-
-tuple2DataType :: DataType
-tuple2DataType = mkDataType "Prelude.(,)" [tuple2Constr]
-
-instance (Data a, Data b) => Data (a,b) where
- gfoldl f z (a,b) = z (,) `f` a `f` b
- toConstr (_,_) = tuple2Constr
- gunfold k z c | constrIndex c == 1 = k (k (z (,)))
- gunfold _ _ _ = error "gunfold"
- dataTypeOf _ = tuple2DataType
- dataCast2 f = gcast2 f
-
-
-------------------------------------------------------------------------------
-
-tuple3Constr :: Constr
-tuple3Constr = mkConstr tuple3DataType "(,,)" [] Infix
-
-tuple3DataType :: DataType
-tuple3DataType = mkDataType "Prelude.(,)" [tuple3Constr]
-
-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 (_,_,_) = tuple3Constr
- gunfold k z c | constrIndex c == 1 = k (k (k (z (,,))))
- gunfold _ _ _ = error "gunfold"
- dataTypeOf _ = tuple3DataType
-
-
-------------------------------------------------------------------------------
-
-tuple4Constr :: Constr
-tuple4Constr = mkConstr tuple4DataType "(,,,)" [] Infix
-
-tuple4DataType :: DataType
-tuple4DataType = mkDataType "Prelude.(,,,)" [tuple4Constr]
-
-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 (_,_,_,_) = tuple4Constr
- gunfold k z c = case constrIndex c of
- 1 -> k (k (k (k (z (,,,)))))
- _ -> error "gunfold"
- dataTypeOf _ = tuple4DataType
-
-
-------------------------------------------------------------------------------
-
-tuple5Constr :: Constr
-tuple5Constr = mkConstr tuple5DataType "(,,,,)" [] Infix
-
-tuple5DataType :: DataType
-tuple5DataType = mkDataType "Prelude.(,,,,)" [tuple5Constr]
-
-instance (Data a, Data b, Data c, Data d, Data e)
- => Data (a,b,c,d,e) where
- gfoldl f z (a,b,c,d,e) = z (,,,,) `f` a `f` b `f` c `f` d `f` e
- toConstr (_,_,_,_,_) = tuple5Constr
- gunfold k z c = case constrIndex c of
- 1 -> k (k (k (k (k (z (,,,,))))))
- _ -> error "gunfold"
- dataTypeOf _ = tuple5DataType
-
-
-------------------------------------------------------------------------------
-
-tuple6Constr :: Constr
-tuple6Constr = mkConstr tuple6DataType "(,,,,,)" [] Infix
-
-tuple6DataType :: DataType
-tuple6DataType = mkDataType "Prelude.(,,,,,)" [tuple6Constr]
-
-instance (Data a, Data b, Data c, Data d, Data e, Data f)
- => Data (a,b,c,d,e,f) where
- gfoldl f z (a,b,c,d,e,f') = z (,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f'
- toConstr (_,_,_,_,_,_) = tuple6Constr
- gunfold k z c = case constrIndex c of
- 1 -> k (k (k (k (k (k (z (,,,,,)))))))
- _ -> error "gunfold"
- dataTypeOf _ = tuple6DataType
-
-
-------------------------------------------------------------------------------
-
-tuple7Constr :: Constr
-tuple7Constr = mkConstr tuple7DataType "(,,,,,,)" [] Infix
-
-tuple7DataType :: DataType
-tuple7DataType = mkDataType "Prelude.(,,,,,,)" [tuple7Constr]
-
-instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
- => Data (a,b,c,d,e,f,g) where
- gfoldl f z (a,b,c,d,e,f',g) =
- z (,,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' `f` g
- toConstr (_,_,_,_,_,_,_) = tuple7Constr
- gunfold k z c = case constrIndex c of
- 1 -> k (k (k (k (k (k (k (z (,,,,,,))))))))
- _ -> error "gunfold"
- dataTypeOf _ = tuple7DataType
-
-
-------------------------------------------------------------------------------
-
-
-instance Data TypeRep where
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "Data.Typeable.TypeRep"
-
-
-------------------------------------------------------------------------------
-
-
-instance Data TyCon where
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "Data.Typeable.TyCon"
-
-
-------------------------------------------------------------------------------
-
-
-INSTANCE_TYPEABLE0(DataType,dataTypeTc,"DataType")
-
-instance Data DataType where
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "Data.Generics.Basics.DataType"
-
-
-------------------------------------------------------------------------------
-
-
-instance Typeable a => Data (IO a) where
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "GHC.IOBase.IO"
-
-
-------------------------------------------------------------------------------
-
-
-instance Data Handle where
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "GHC.IOBase.Handle"
-
-
-------------------------------------------------------------------------------
-
-
-instance Typeable a => Data (Ptr a) where
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "GHC.Ptr.Ptr"
-
-
-------------------------------------------------------------------------------
-
-
-instance Typeable a => Data (StablePtr a) where
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "GHC.Stable.StablePtr"
-
-
-------------------------------------------------------------------------------
-
-
-instance Typeable a => Data (IORef a) where
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "GHC.IOBase.IORef"
-
-
-------------------------------------------------------------------------------
-
-
-instance Typeable a => Data (ForeignPtr a) where
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "GHC.ForeignPtr.ForeignPtr"
-
-
-------------------------------------------------------------------------------
-
-
-instance (Typeable s, Typeable a) => Data (ST s a) where
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "GHC.ST.ST"
-
-
-------------------------------------------------------------------------------
-
-
-instance Data ThreadId where
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "GHC.Conc.ThreadId"
-
-
-------------------------------------------------------------------------------
-
-
-instance Typeable a => Data (TVar a) where
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "GHC.Conc.TVar"
-
-
-------------------------------------------------------------------------------
-
-
-instance Typeable a => Data (MVar a) where
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "GHC.Conc.MVar"
-
-
-------------------------------------------------------------------------------
-
-
-instance Typeable a => Data (STM a) where
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "GHC.Conc.STM"
-
-
-------------------------------------------------------------------------------
--- The Data instance for Array preserves data abstraction at the cost of inefficiency.
--- We omit reflection services for the sake of data abstraction.
-instance (Typeable a, Data b, Ix a) => Data (Array a b)
- where
- gfoldl f z a = z (listArray (bounds a)) `f` (elems a)
- toConstr _ = error "toConstr"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNorepType "Data.Array.Array"
-
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : Data.Generics.Schemes
--- Copyright : (c) The University of Glasgow, CWI 2001--2003
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries@haskell.org
--- Stability : experimental
--- Portability : non-portable (local universal quantification)
---
--- \"Scrap your boilerplate\" --- Generic programming in Haskell
--- See <http://www.cs.vu.nl/boilerplate/>. The present module provides
--- frequently used generic traversal schemes.
---
------------------------------------------------------------------------------
-
-module Data.Generics.Schemes (
-
- everywhere,
- everywhere',
- everywhereBut,
- everywhereM,
- somewhere,
- everything,
- listify,
- something,
- synthesize,
- gsize,
- glength,
- gdepth,
- gcount,
- gnodecount,
- gtypecount,
- gfindtype
-
- ) where
-
-------------------------------------------------------------------------------
-
-#ifdef __HADDOCK__
-import Prelude
-#endif
-import Data.Generics.Basics
-import Data.Generics.Aliases
-import Control.Monad
-
-
--- | Apply a transformation everywhere in bottom-up manner
-everywhere :: (forall a. Data a => a -> a)
- -> (forall a. Data a => a -> a)
-
--- Use gmapT to recurse into immediate subterms;
--- recall: gmapT preserves the outermost constructor;
--- post-process recursively transformed result via f
---
-everywhere f = f . gmapT (everywhere f)
-
-
--- | Apply a transformation everywhere in top-down manner
-everywhere' :: (forall a. Data a => a -> a)
- -> (forall a. Data a => a -> a)
-
--- Arguments of (.) are flipped compared to everywhere
-everywhere' f = gmapT (everywhere' f) . f
-
-
--- | Variation on everywhere with an extra stop condition
-everywhereBut :: GenericQ Bool -> GenericT -> GenericT
-
--- Guarded to let traversal cease if predicate q holds for x
-everywhereBut q f x
- | q x = x
- | otherwise = f (gmapT (everywhereBut q f) x)
-
-
--- | Monadic variation on everywhere
-everywhereM :: Monad m => GenericM m -> GenericM m
-
--- Bottom-up order is also reflected in order of do-actions
-everywhereM f x = do x' <- gmapM (everywhereM f) x
- f x'
-
-
--- | Apply a monadic transformation at least somewhere
-somewhere :: MonadPlus m => GenericM m -> GenericM m
-
--- We try "f" in top-down manner, but descent into "x" when we fail
--- at the root of the term. The transformation fails if "f" fails
--- everywhere, say succeeds nowhere.
---
-somewhere f x = f x `mplus` gmapMp (somewhere f) x
-
-
--- | Summarise all nodes in top-down, left-to-right order
-everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
-
--- Apply f to x to summarise top-level node;
--- use gmapQ to recurse into immediate subterms;
--- use ordinary foldl to reduce list of intermediate results
---
-everything k f x
- = foldl k (f x) (gmapQ (everything k f) x)
-
-
--- | Get a list of all entities that meet a predicate
-listify :: Typeable r => (r -> Bool) -> GenericQ [r]
-listify p
- = everything (++) ([] `mkQ` (\x -> if p x then [x] else []))
-
-
--- | Look up a subterm by means of a maybe-typed filter
-something :: GenericQ (Maybe u) -> GenericQ (Maybe u)
-
--- "something" can be defined in terms of "everything"
--- when a suitable "choice" operator is used for reduction
---
-something = everything orElse
-
-
--- | Bottom-up synthesis of a data structure;
--- 1st argument z is the initial element for the synthesis;
--- 2nd argument o is for reduction of results from subterms;
--- 3rd argument f updates the synthesised data according to the given term
---
-synthesize :: s -> (t -> s -> s) -> GenericQ (s -> t) -> GenericQ t
-synthesize z o f x = f x (foldr o z (gmapQ (synthesize z o f) x))
-
-
--- | Compute size of an arbitrary data structure
-gsize :: Data a => a -> Int
-gsize t = 1 + sum (gmapQ gsize t)
-
-
--- | Count the number of immediate subterms of the given term
-glength :: GenericQ Int
-glength = length . gmapQ (const ())
-
-
--- | Determine depth of the given term
-gdepth :: GenericQ Int
-gdepth = (+) 1 . foldr max 0 . gmapQ gdepth
-
-
--- | Determine the number of all suitable nodes in a given term
-gcount :: GenericQ Bool -> GenericQ Int
-gcount p = everything (+) (\x -> if p x then 1 else 0)
-
-
--- | Determine the number of all nodes in a given term
-gnodecount :: GenericQ Int
-gnodecount = gcount (const True)
-
-
--- | Determine the number of nodes of a given type in a given term
-gtypecount :: Typeable a => a -> GenericQ Int
-gtypecount (_::a) = gcount (False `mkQ` (\(_::a) -> True))
-
-
--- | Find (unambiguously) an immediate subterm of a given type
-gfindtype :: (Data x, Typeable y) => x -> Maybe y
-gfindtype = singleton
- . foldl unJust []
- . gmapQ (Nothing `mkQ` Just)
- where
- unJust l (Just x) = x:l
- unJust l Nothing = l
- singleton [s] = Just s
- singleton _ = Nothing
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : Data.Generics.Text
--- Copyright : (c) The University of Glasgow, CWI 2001--2003
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries@haskell.org
--- Stability : experimental
--- Portability : non-portable (uses Data.Generics.Basics)
---
--- \"Scrap your boilerplate\" --- Generic programming in Haskell
--- See <http://www.cs.vu.nl/boilerplate/>. The present module provides
--- generic operations for text serialisation of terms.
---
------------------------------------------------------------------------------
-
-module Data.Generics.Text (
-
- gshow,
- gread
-
- ) where
-
-------------------------------------------------------------------------------
-
-#ifdef __HADDOCK__
-import Prelude
-#endif
-import Control.Monad
-import Data.Maybe
-import Data.Generics.Basics
-import Data.Generics.Aliases
-import Text.ParserCombinators.ReadP
-
-------------------------------------------------------------------------------
-
-
--- | Generic show: an alternative to \"deriving Show\"
-gshow :: Data a => a -> String
-
--- This is a prefix-show using surrounding "(" and ")",
--- where we recurse into subterms with gmapQ.
---
-gshow = ( \t ->
- "("
- ++ showConstr (toConstr t)
- ++ concat (gmapQ ((++) " " . gshow) t)
- ++ ")"
- ) `extQ` (show :: String -> String)
-
-
-
--- | Generic read: an alternative to \"deriving Read\"
-gread :: Data a => ReadS a
-
-{-
-
-This is a read operation which insists on prefix notation. (The
-Haskell 98 read deals with infix operators subject to associativity
-and precedence as well.) We use fromConstrM to "parse" the input. To be
-precise, fromConstrM is used for all types except String. The
-type-specific case for String uses basic String read.
-
--}
-
-gread = readP_to_S gread'
-
- where
-
- -- Helper for recursive read
- gread' :: Data a' => ReadP a'
- gread' = allButString `extR` stringCase
-
- where
-
- -- A specific case for strings
- stringCase :: ReadP String
- stringCase = readS_to_P reads
-
- -- Determine result type
- myDataType = dataTypeOf (getArg allButString)
- where
- getArg :: ReadP a'' -> a''
- getArg = undefined
-
- -- The generic default for gread
- allButString =
- do
- -- Drop " ( "
- skipSpaces -- Discard leading space
- char '(' -- Parse '('
- skipSpaces -- Discard following space
-
- -- Do the real work
- str <- parseConstr -- Get a lexeme for the constructor
- con <- str2con str -- Convert it to a Constr (may fail)
- x <- fromConstrM gread' con -- Read the children
-
- -- Drop " ) "
- skipSpaces -- Discard leading space
- char ')' -- Parse ')'
- skipSpaces -- Discard following space
-
- return x
-
- -- Turn string into constructor driven by the requested result type,
- -- failing in the monad if it isn't a constructor of this data type
- str2con :: String -> ReadP Constr
- str2con = maybe mzero return
- . readConstr myDataType
-
- -- Get a Constr's string at the front of an input string
- parseConstr :: ReadP String
- parseConstr =
- string "[]" -- Compound lexeme "[]"
- <++ infixOp -- Infix operator in parantheses
- <++ readS_to_P lex -- Ordinary constructors and literals
-
- -- Handle infix operators such as (:)
- infixOp :: ReadP String
- infixOp = do c1 <- char '('
- str <- munch1 (not . (==) ')')
- c2 <- char ')'
- return $ [c1] ++ str ++ [c2]
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : Data.Generics.Twins
--- 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 (local universal quantification)
---
--- \"Scrap your boilerplate\" --- Generic programming in Haskell
--- See <http://www.cs.vu.nl/boilerplate/>. The present module
--- provides support for multi-parameter traversal, which is also
--- demonstrated with generic operations like equality.
---
------------------------------------------------------------------------------
-
-module Data.Generics.Twins (
-
- -- * Generic folds and maps that also accumulate
- gfoldlAccum,
- gmapAccumT,
- gmapAccumM,
- gmapAccumQl,
- gmapAccumQr,
- gmapAccumQ,
-
- -- * Mapping combinators for twin traversal
- gzipWithT,
- gzipWithM,
- gzipWithQ,
-
- -- * Typical twin traversals
- geq,
- gzip
-
- ) where
-
-
-------------------------------------------------------------------------------
-
-#ifdef __HADDOCK__
-import Prelude
-#endif
-import Data.Generics.Basics
-import Data.Generics.Aliases
-
-#ifdef __GLASGOW_HASKELL__
-import Prelude hiding ( GT )
-#endif
-
-------------------------------------------------------------------------------
-
-
-------------------------------------------------------------------------------
---
--- Generic folds and maps that also accumulate
---
-------------------------------------------------------------------------------
-
-{--------------------------------------------------------------
-
-A list map can be elaborated to perform accumulation.
-In the same sense, we can elaborate generic maps over terms.
-
-We recall the type of map:
-map :: (a -> b) -> [a] -> [b]
-
-We recall the type of an accumulating map (see Data.List):
-mapAccumL :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
-
-Applying the same scheme we obtain an accumulating gfoldl.
-
---------------------------------------------------------------}
-
--- | gfoldl with accumulation
-
-gfoldlAccum :: Data d
- => (forall e r. Data e => a -> c (e -> r) -> e -> (a, c r))
- -> (forall g. a -> g -> (a, c g))
- -> a -> d -> (a, c d)
-
-gfoldlAccum k z a0 d = unA (gfoldl k' z' d) a0
- where
- k' c y = A (\a -> let (a', c') = unA c a in k a' c' y)
- z' f = A (\a -> z a f)
-
-
--- | A type constructor for accumulation
-newtype A a c d = A { unA :: a -> (a, c d) }
-
-
--- | gmapT with accumulation
-gmapAccumT :: Data d
- => (forall e. Data e => a -> e -> (a,e))
- -> a -> d -> (a, d)
-gmapAccumT f a0 d0 = let (a1, d1) = gfoldlAccum k z a0 d0
- in (a1, unID d1)
- where
- k a (ID c) d = let (a',d') = f a d
- in (a', ID (c d'))
- z a x = (a, ID x)
-
-
--- | gmapM with accumulation
-gmapAccumM :: (Data d, Monad m)
- => (forall e. Data e => a -> e -> (a, m e))
- -> a -> d -> (a, m d)
-gmapAccumM f = gfoldlAccum k z
- where
- k a c d = let (a',d') = f a d
- in (a', d' >>= \d'' -> c >>= \c' -> return (c' d''))
- z a x = (a, return x)
-
-
--- | gmapQl with accumulation
-gmapAccumQl :: Data d
- => (r -> r' -> r)
- -> r
- -> (forall e. Data e => a -> e -> (a,r'))
- -> a -> d -> (a, r)
-gmapAccumQl o r0 f a0 d0 = let (a1, r1) = gfoldlAccum k z a0 d0
- in (a1, unCONST r1)
- where
- k a (CONST c) d = let (a', r) = f a d
- in (a', CONST (c `o` r))
- z a _ = (a, CONST r0)
-
-
--- | gmapQr with accumulation
-gmapAccumQr :: Data d
- => (r' -> r -> r)
- -> r
- -> (forall e. Data e => a -> e -> (a,r'))
- -> a -> d -> (a, r)
-gmapAccumQr o r0 f a0 d0 = let (a1, l) = gfoldlAccum k z a0 d0
- in (a1, unQr l r0)
- where
- k a (Qr c) d = let (a',r') = f a d
- in (a', Qr (\r -> c (r' `o` r)))
- z a _ = (a, Qr id)
-
-
--- | gmapQ with accumulation
-gmapAccumQ :: Data d
- => (forall e. Data e => a -> e -> (a,q))
- -> a -> d -> (a, [q])
-gmapAccumQ f = gmapAccumQr (:) [] f
-
-
-
-------------------------------------------------------------------------------
---
--- Helper type constructors
---
-------------------------------------------------------------------------------
-
-
--- | The identity type constructor needed for the definition of gmapAccumT
-newtype ID x = ID { unID :: x }
-
-
--- | The constant type constructor needed for the definition of gmapAccumQl
-newtype CONST c a = CONST { unCONST :: c }
-
-
--- | The type constructor needed for the definition of gmapAccumQr
-newtype Qr r a = Qr { unQr :: r -> r }
-
-
-
-------------------------------------------------------------------------------
---
--- Mapping combinators for twin traversal
---
-------------------------------------------------------------------------------
-
-
--- | Twin map for transformation
-gzipWithT :: GenericQ (GenericT) -> GenericQ (GenericT)
-gzipWithT f x y = case gmapAccumT perkid funs y of
- ([], c) -> c
- _ -> error "gzipWithT"
- where
- perkid a d = (tail a, unGT (head a) d)
- funs = gmapQ (\k -> GT (f k)) x
-
-
-
--- | Twin map for monadic transformation
-gzipWithM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)
-gzipWithM f x y = case gmapAccumM perkid funs y of
- ([], c) -> c
- _ -> error "gzipWithM"
- where
- perkid a d = (tail a, unGM (head a) d)
- funs = gmapQ (\k -> GM (f k)) x
-
-
--- | Twin map for queries
-gzipWithQ :: GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
-gzipWithQ f x y = case gmapAccumQ perkid funs y of
- ([], r) -> r
- _ -> error "gzipWithQ"
- where
- perkid a d = (tail a, unGQ (head a) d)
- funs = gmapQ (\k -> GQ (f k)) x
-
-
-
-------------------------------------------------------------------------------
---
--- Typical twin traversals
---
-------------------------------------------------------------------------------
-
--- | Generic equality: an alternative to \"deriving Eq\"
-geq :: Data a => a -> a -> Bool
-
-{-
-
-Testing for equality of two terms goes like this. Firstly, we
-establish the equality of the two top-level datatype
-constructors. Secondly, we use a twin gmap combinator, namely tgmapQ,
-to compare the two lists of immediate subterms.
-
-(Note for the experts: the type of the worker geq' is rather general
-but precision is recovered via the restrictive type of the top-level
-operation geq. The imprecision of geq' is caused by the type system's
-unability to express the type equivalence for the corresponding
-couples of immediate subterms from the two given input terms.)
-
--}
-
-geq x0 y0 = geq' x0 y0
- where
- geq' :: GenericQ (GenericQ Bool)
- geq' x y = (toConstr x == toConstr y)
- && and (gzipWithQ geq' x y)
-
-
--- | Generic zip controlled by a function with type-specific branches
-gzip :: GenericQ (GenericM Maybe) -> GenericQ (GenericM Maybe)
--- See testsuite/.../Generics/gzip.hs for an illustration
-gzip f x y =
- f x y
- `orElse`
- if toConstr x == toConstr y
- then gzipWithM (gzip f) x y
- else Nothing
if impl(ghc) {
build-depends: rts, ghc-prim, integer
exposed-modules:
- Data.Generics,
- Data.Generics.Aliases,
- Data.Generics.Basics,
- Data.Generics.Instances,
- Data.Generics.Schemes,
- Data.Generics.Text,
- Data.Generics.Twins,
Foreign.Concurrent,
GHC.Arr,
GHC.Base,
projects / ghc-base.git / commitdiff