New patches: [moved Basics and most instances to base 'Jose Pedro Magalhaes '**20081002083058] { hunk ./Data/Generics/Basics.hs 18 - - -- * 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 - + module Data.Data hunk ./Data/Generics/Basics.hs 21 - ------------------------------------------------------------------------------- - -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') +import Data.Data hunk ./Data/Generics/Instances.hs 21 +import Data.Data + hunk ./Data/Generics/Instances.hs 30 -import Data.Generics.Basics +import Data.Data hunk ./Data/Generics/Instances.hs 33 -import Data.Int -- So we can give Data instance for Int8, ... -import Data.Word -- So we can give Data instance for Word8, ... -import Data.Complex hunk ./Data/Generics/Instances.hs 34 -import GHC.Real( Ratio(..) ) -- So we can give Data instance for Ratio hunk ./Data/Generics/Instances.hs 35 -import GHC.Ptr -- So we can give Data instance for Ptr -import GHC.ForeignPtr -- So we can give Data instance for ForeignPtr hunk ./Data/Generics/Instances.hs 38 -import GHC.Arr -- So we can give Data instance for Array hunk ./Data/Generics/Instances.hs 48 -import Data.Array hunk ./Data/Generics/Instances.hs 62 -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 - - ------------------------------------------------------------------------------- - -complexConstr :: Constr -complexConstr = mkConstr complexDataType ":+" [] Infix - -complexDataType :: DataType -complexDataType = mkDataType "Data.Complex.Complex" [complexConstr] - -instance (Data a, RealFloat a) => Data (Complex a) where - toConstr _ = complexConstr - gunfold k z c | constrIndex c == 1 = k (k (z (:+))) - gunfold _ _ _ = error "gunfold" - dataTypeOf _ = complexDataType - - ------------------------------------------------------------------------------- - -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 - - hunk ./Data/Generics/Instances.hs 63 - -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 - - +-- Instances of abstract datatypes (6) hunk ./Data/Generics/Instances.hs 66 -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 - - ------------------------------------------------------------------------------- - - hunk ./Data/Generics/Instances.hs 74 - hunk ./Data/Generics/Instances.hs 82 - hunk ./Data/Generics/Instances.hs 92 - -instance Typeable a => Data (IO a) where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "GHC.IOBase.IO" - - ------------------------------------------------------------------------------- - - hunk ./Data/Generics/Instances.hs 100 - -instance Typeable a => Data (Ptr a) where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "GHC.Ptr.Ptr" - - ------------------------------------------------------------------------------- - - hunk ./Data/Generics/Instances.hs 108 - -instance Typeable a => Data (IORef a) where +#ifdef __GLASGOW_HASKELL__ +instance Data ThreadId where hunk ./Data/Generics/Instances.hs 112 - dataTypeOf _ = mkNorepType "GHC.IOBase.IORef" + dataTypeOf _ = mkNorepType "GHC.Conc.ThreadId" +#endif hunk ./Data/Generics/Instances.hs 117 +-- Dubious instances (7) +------------------------------------------------------------------------------ hunk ./Data/Generics/Instances.hs 120 - -instance Typeable a => Data (ForeignPtr a) where +#ifdef __GLASGOW_HASKELL__ +instance Typeable a => Data (TVar a) where hunk ./Data/Generics/Instances.hs 124 - dataTypeOf _ = mkNorepType "GHC.ForeignPtr.ForeignPtr" + dataTypeOf _ = mkNorepType "GHC.Conc.TVar" +#endif hunk ./Data/Generics/Instances.hs 130 - -instance (Typeable s, Typeable a) => Data (ST s a) where +instance Typeable a => Data (MVar a) where hunk ./Data/Generics/Instances.hs 133 - dataTypeOf _ = mkNorepType "GHC.ST.ST" + dataTypeOf _ = mkNorepType "GHC.Conc.MVar" hunk ./Data/Generics/Instances.hs 139 -instance Data ThreadId where +instance Typeable a => Data (STM a) where hunk ./Data/Generics/Instances.hs 142 - dataTypeOf _ = mkNorepType "GHC.Conc.ThreadId" + dataTypeOf _ = mkNorepType "GHC.Conc.STM" hunk ./Data/Generics/Instances.hs 145 ------------------------------------------------------------------------------- - -#ifdef __GLASGOW_HASKELL__ -instance Typeable a => Data (TVar a) where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "GHC.Conc.TVar" -#endif hunk ./Data/Generics/Instances.hs 148 - -instance Typeable a => Data (MVar a) where +instance (Typeable s, Typeable a) => Data (ST s a) where hunk ./Data/Generics/Instances.hs 151 - dataTypeOf _ = mkNorepType "GHC.Conc.MVar" + dataTypeOf _ = mkNorepType "GHC.ST.ST" hunk ./Data/Generics/Instances.hs 156 -#ifdef __GLASGOW_HASKELL__ -instance Typeable a => Data (STM a) where +instance Typeable a => Data (IORef a) where hunk ./Data/Generics/Instances.hs 159 - dataTypeOf _ = mkNorepType "GHC.Conc.STM" -#endif + dataTypeOf _ = mkNorepType "GHC.IOBase.IORef" + hunk ./Data/Generics/Instances.hs 163 --- 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) + +instance Typeable a => Data (IO a) where hunk ./Data/Generics/Instances.hs 167 - dataTypeOf _ = mkNorepType "Data.Array.Array" + dataTypeOf _ = mkNorepType "GHC.IOBase.IO" hunk ./Data/Generics.hs 21 - module Data.Generics.Basics, -- primitives - module Data.Generics.Instances, -- instances of Data class + module Data.Generics.Basics, + module Data.Generics.Instances, -- } [updated documentation 'Jose Pedro Magalhaes '**20081003100347] { hunk ./Data/Generics/Basics.hs 13 --- the 'Data' class with its primitives for generic programming. +-- the 'Data' class with its primitives for generic programming, +-- which is now defined in "Data.Data". Therefore this module simply +-- re-exports "Data.Data". hunk ./Data/Generics/Instances.hs 9 --- Portability : non-portable (uses Data.Generics.Basics) +-- Portability : non-portable (uses Data.Data) hunk ./Data/Generics/Instances.hs 13 --- instantiates the class Data for Prelude-like datatypes. +-- contains thirteen 'Data' instances which are considered dubious (either +-- because the types are abstract or just not meant to be traversed). +-- Instances in this module might change or disappear in future releases +-- of this package. +-- } [updated imports 'Jose Pedro Magalhaes '**20081003100443] { hunk ./Data/Generics/Instances.hs 23 -module Data.Generics.Instances where - -import Data.Data - +module Data.Generics.Instances () where hunk ./Data/Generics/Instances.hs 32 - hunk ./Data/Generics/Instances.hs 33 + } [removed empty export list 'Jose Pedro Magalhaes '**20081003120324] { hunk ./Data/Generics/Instances.hs 23 -module Data.Generics.Instances () where +module Data.Generics.Instances where } Context: [Pad version number to 0.1.0.0 Ian Lynagh **20080920160232] [TAG 6.10 branch has been forked Ian Lynagh **20080919123438] Patch bundle hash: 3e1ecfdd777a1b09e57c21714cb5a54c1831d8b9