From: Ian Lynagh Date: Mon, 25 Aug 2008 21:41:44 +0000 (+0000) Subject: Split syb off into its own package X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=5ba151f462d0ec7ee9241b3c259979d51777f39b;p=ghc-base.git Split syb off into its own package I've also moved the Data (Complex a) instance into it, and made it portable rather than GHC-only in the process. --- diff --git a/Data/Complex.hs b/Data/Complex.hs index 7d29e77..3acfa03 100644 --- a/Data/Complex.hs +++ b/Data/Complex.hs @@ -44,9 +44,6 @@ module Data.Complex import Prelude import Data.Typeable -#ifdef __GLASGOW_HASKELL__ -import Data.Generics.Basics( Data ) -#endif #ifdef __HUGS__ import Hugs.Prelude(Num(fromInt), Fractional(fromDouble)) @@ -65,11 +62,7 @@ infix 6 :+ 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 diff --git a/Data/Generics.hs b/Data/Generics.hs deleted file mode 100644 index d496ec8..0000000 --- a/Data/Generics.hs +++ /dev/null @@ -1,53 +0,0 @@ ------------------------------------------------------------------------------ --- | --- 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 . 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 diff --git a/Data/Generics/Aliases.hs b/Data/Generics/Aliases.hs deleted file mode 100644 index 0d8e95b..0000000 --- a/Data/Generics/Aliases.hs +++ /dev/null @@ -1,368 +0,0 @@ ------------------------------------------------------------------------------ --- | --- 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 . 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 } diff --git a/Data/Generics/Basics.hs b/Data/Generics/Basics.hs deleted file mode 100644 index df4ad0e..0000000 --- a/Data/Generics/Basics.hs +++ /dev/null @@ -1,766 +0,0 @@ ------------------------------------------------------------------------------ --- | --- 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 . 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') diff --git a/Data/Generics/Instances.hs b/Data/Generics/Instances.hs deleted file mode 100644 index daa11bf..0000000 --- a/Data/Generics/Instances.hs +++ /dev/null @@ -1,648 +0,0 @@ ------------------------------------------------------------------------------ --- | --- 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 . 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" - diff --git a/Data/Generics/Schemes.hs b/Data/Generics/Schemes.hs deleted file mode 100644 index 4e75a82..0000000 --- a/Data/Generics/Schemes.hs +++ /dev/null @@ -1,168 +0,0 @@ ------------------------------------------------------------------------------ --- | --- 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 . 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 diff --git a/Data/Generics/Text.hs b/Data/Generics/Text.hs deleted file mode 100644 index 0137c36..0000000 --- a/Data/Generics/Text.hs +++ /dev/null @@ -1,124 +0,0 @@ ------------------------------------------------------------------------------ --- | --- 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 . 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] diff --git a/Data/Generics/Twins.hs b/Data/Generics/Twins.hs deleted file mode 100644 index e66be72..0000000 --- a/Data/Generics/Twins.hs +++ /dev/null @@ -1,250 +0,0 @@ ------------------------------------------------------------------------------ --- | --- 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 . 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 diff --git a/base.cabal b/base.cabal index 87dbddd..ab7a77b 100644 --- a/base.cabal +++ b/base.cabal @@ -21,13 +21,6 @@ Library { 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,