--
-- Maintainer : libraries@haskell.org
-- Stability : experimental
--- Portability : non-portable
+-- Portability : non-portable (uses Data.Generics.Basics)
--
-- \"Scrap your boilerplate\" --- Generic programming in Haskell
-- See <http://www.cs.vu.nl/boilerplate/>. The present module
-- instantiates the class Data for Prelude-like datatypes.
+-- (This module does not export anything. It really just defines instances.)
--
-----------------------------------------------------------------------------
module Data.Generics.Instances
+
where
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"
------------------------------------------------------------------------------
-falseConstr = mkDataCon boolDataType "False" Prefix
-trueConstr = mkDataCon boolDataType "True" Prefix
+falseConstr = mkConstr boolDataType "False" [] Prefix
+trueConstr = mkConstr boolDataType "True" [] Prefix
boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr]
+
instance Data Bool where
toConstr False = falseConstr
toConstr True = trueConstr
- fromConstr c = case conIndex c of
- 1 -> False
- 2 -> True
- _ -> error "fromConstr"
+ gunfold k z c = case constrIndex c of
+ 1 -> z False
+ 2 -> z True
+ _ -> error "gunfold"
dataTypeOf _ = boolDataType
charType = mkStringType "Prelude.Char"
instance Data Char where
- toConstr x = mkStringCon charType [x]
- fromConstr con = case conRep con of
- (StringCon [x]) -> x
- _ -> error "fromConstr"
+ toConstr x = mkStringConstr charType [x]
+ gunfold k z c = case constrRep c of
+ (StringConstr [x]) -> z x
+ _ -> error "gunfold"
dataTypeOf _ = charType
floatType = mkFloatType "Prelude.Float"
instance Data Float where
- toConstr x = mkFloatCon floatType (realToFrac x)
- fromConstr con = case conRep con of
- (FloatCon x) -> realToFrac x
- _ -> error "fromConstr"
+ toConstr x = mkFloatConstr floatType (realToFrac x)
+ gunfold k z c = case constrRep c of
+ (FloatConstr x) -> z (realToFrac x)
+ _ -> error "gunfold"
dataTypeOf _ = floatType
doubleType = mkFloatType "Prelude.Double"
instance Data Double where
- toConstr = mkFloatCon floatType
- fromConstr con = case conRep con of
- (FloatCon x) -> x
- _ -> error "fromConstr"
+ toConstr = mkFloatConstr floatType
+ gunfold k z c = case constrRep c of
+ (FloatConstr x) -> z x
+ _ -> error "gunfold"
dataTypeOf _ = doubleType
intType = mkIntType "Prelude.Int"
instance Data Int where
- toConstr x = mkIntCon intType (fromIntegral x)
- fromConstr con = case conRep con of
- (IntCon x) -> fromIntegral x
- _ -> error "fromConstr"
+ toConstr x = mkIntConstr intType (fromIntegral x)
+ gunfold k z c = case constrRep c of
+ (IntConstr x) -> z (fromIntegral x)
+ _ -> error "gunfold"
dataTypeOf _ = intType
integerType = mkIntType "Prelude.Integer"
instance Data Integer where
- toConstr = mkIntCon integerType
- fromConstr con = case conRep con of
- (IntCon x) -> x
- _ -> error "fromConstr"
+ toConstr = mkIntConstr integerType
+ gunfold k z c = case constrRep c of
+ (IntConstr x) -> z x
+ _ -> error "gunfold"
dataTypeOf _ = integerType
int8Type = mkIntType "Data.Int.Int8"
instance Data Int8 where
- toConstr x = mkIntCon int8Type (fromIntegral x)
- fromConstr con = case conRep con of
- (IntCon x) -> fromIntegral x
- _ -> error "fromConstr"
+ toConstr x = mkIntConstr int8Type (fromIntegral x)
+ gunfold k z c = case constrRep c of
+ (IntConstr x) -> z (fromIntegral x)
+ _ -> error "gunfold"
dataTypeOf _ = int8Type
int16Type = mkIntType "Data.Int.Int16"
instance Data Int16 where
- toConstr x = mkIntCon int16Type (fromIntegral x)
- fromConstr con = case conRep con of
- (IntCon x) -> fromIntegral x
- _ -> error "fromConstr"
+ toConstr x = mkIntConstr int16Type (fromIntegral x)
+ gunfold k z c = case constrRep c of
+ (IntConstr x) -> z (fromIntegral x)
+ _ -> error "gunfold"
dataTypeOf _ = int16Type
int32Type = mkIntType "Data.Int.Int32"
instance Data Int32 where
- toConstr x = mkIntCon int32Type (fromIntegral x)
- fromConstr con = case conRep con of
- (IntCon x) -> fromIntegral x
- _ -> error "fromConstr"
+ toConstr x = mkIntConstr int32Type (fromIntegral x)
+ gunfold k z c = case constrRep c of
+ (IntConstr x) -> z (fromIntegral x)
+ _ -> error "gunfold"
dataTypeOf _ = int32Type
int64Type = mkIntType "Data.Int.Int64"
instance Data Int64 where
- toConstr x = mkIntCon int64Type (fromIntegral x)
- fromConstr con = case conRep con of
- (IntCon x) -> fromIntegral x
- _ -> error "fromConstr"
+ toConstr x = mkIntConstr int64Type (fromIntegral x)
+ gunfold k z c = case constrRep c of
+ (IntConstr x) -> z (fromIntegral x)
+ _ -> error "gunfold"
dataTypeOf _ = int64Type
wordType = mkIntType "Data.Word.Word"
instance Data Word where
- toConstr x = mkIntCon wordType (fromIntegral x)
- fromConstr con = case conRep con of
- (IntCon x) -> fromIntegral x
- _ -> error "fromConstr"
+ toConstr x = mkIntConstr wordType (fromIntegral x)
+ gunfold k z c = case constrRep c of
+ (IntConstr x) -> z (fromIntegral x)
+ _ -> error "gunfold"
dataTypeOf _ = wordType
word8Type = mkIntType "Data.Word.Word8"
instance Data Word8 where
- toConstr x = mkIntCon word8Type (fromIntegral x)
- fromConstr con = case conRep con of
- (IntCon x) -> fromIntegral x
- _ -> error "fromConstr"
+ toConstr x = mkIntConstr word8Type (fromIntegral x)
+ gunfold k z c = case constrRep c of
+ (IntConstr x) -> z (fromIntegral x)
+ _ -> error "gunfold"
dataTypeOf _ = word8Type
word16Type = mkIntType "Data.Word.Word16"
instance Data Word16 where
- toConstr x = mkIntCon word16Type (fromIntegral x)
- fromConstr con = case conRep con of
- (IntCon x) -> fromIntegral x
- _ -> error "fromConstr"
+ toConstr x = mkIntConstr word16Type (fromIntegral x)
+ gunfold k z c = case constrRep c of
+ (IntConstr x) -> z (fromIntegral x)
+ _ -> error "gunfold"
dataTypeOf _ = word16Type
word32Type = mkIntType "Data.Word.Word32"
instance Data Word32 where
- toConstr x = mkIntCon word32Type (fromIntegral x)
- fromConstr con = case conRep con of
- (IntCon x) -> fromIntegral x
- _ -> error "fromConstr"
+ toConstr x = mkIntConstr word32Type (fromIntegral x)
+ gunfold k z c = case constrRep c of
+ (IntConstr x) -> z (fromIntegral x)
+ _ -> error "gunfold"
dataTypeOf _ = word32Type
word64Type = mkIntType "Data.Word.Word64"
instance Data Word64 where
- toConstr x = mkIntCon word64Type (fromIntegral x)
- fromConstr con = case conRep con of
- (IntCon x) -> fromIntegral x
- _ -> error "fromConstr"
+ toConstr x = mkIntConstr word64Type (fromIntegral x)
+ gunfold k z c = case constrRep c of
+ (IntConstr x) -> z (fromIntegral x)
+ _ -> error "gunfold"
dataTypeOf _ = word64Type
------------------------------------------------------------------------------
-ratioConstr = mkDataCon ratioDataType ":%" Infix
+ratioConstr = mkConstr ratioDataType ":%" [] Infix
ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr]
instance (Data a, Integral a) => Data (Ratio a) where
toConstr _ = ratioConstr
- fromConstr c | conIndex c == 1 = undefined :% undefined
- fromConstr _ = error "fromConstr"
- dataTypeOf _ = ratioDataType
+ gunfold k z c | constrIndex c == 1 = k (k (z (:%)))
+ gunfold _ _ _ = error "gunfold"
+ dataTypeOf _ = ratioDataType
------------------------------------------------------------------------------
-nilConstr = mkDataCon listDataType "[]" Prefix
-consConstr = mkDataCon listDataType "(:)" Infix
+nilConstr = mkConstr listDataType "[]" [] Prefix
+consConstr = mkConstr listDataType "(:)" [] Infix
listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]
instance Data a => Data [a] where
gfoldl f z (x:xs) = z (:) `f` x `f` xs
toConstr [] = nilConstr
toConstr (_:_) = consConstr
- fromConstr c = case conIndex c of
- 1 -> []
- 2 -> undefined:undefined
- _ -> error "fromConstr"
+ gunfold k z c = case constrIndex c of
+ 1 -> z []
+ 2 -> k (k (z (:)))
+ _ -> error "gunfold"
dataTypeOf _ = listDataType
- cast0to1 = cast1
+ dataCast1 f = gcast1 f
--
-- The gmaps are given as an illustration.
------------------------------------------------------------------------------
-nothingConstr = mkDataCon maybeDataType "Nothing" Prefix
-justConstr = mkDataCon maybeDataType "Just" Prefix
+nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix
+justConstr = mkConstr maybeDataType "Just" [] Prefix
maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr]
instance Data a => Data (Maybe a) where
gfoldl f z (Just x) = z Just `f` x
toConstr Nothing = nothingConstr
toConstr (Just _) = justConstr
- fromConstr c = case conIndex c of
- 1 -> Nothing
- 2 -> Just undefined
- _ -> error "fromConstr"
+ gunfold k z c = case constrIndex c of
+ 1 -> z Nothing
+ 2 -> k (z Just)
+ _ -> error "gunfold"
dataTypeOf _ = maybeDataType
- cast0to1 = cast1
+ dataCast1 f = gcast1 f
------------------------------------------------------------------------------
-ltConstr = mkDataCon orderingDataType "LT" Prefix
-eqConstr = mkDataCon orderingDataType "EQ" Prefix
-gtConstr = mkDataCon orderingDataType "GT" Prefix
+ltConstr = mkConstr orderingDataType "LT" [] Prefix
+eqConstr = mkConstr orderingDataType "EQ" [] Prefix
+gtConstr = mkConstr orderingDataType "GT" [] Prefix
orderingDataType = mkDataType "Prelude.Ordering" [ltConstr,eqConstr,gtConstr]
instance Data Ordering where
toConstr LT = ltConstr
toConstr EQ = eqConstr
toConstr GT = gtConstr
- fromConstr c = case conIndex c of
- 1 -> LT
- 2 -> EQ
- 3 -> GT
- _ -> error "fromConstr"
+ gunfold k z c = case constrIndex c of
+ 1 -> z LT
+ 2 -> z EQ
+ 3 -> z GT
+ _ -> error "gunfold"
dataTypeOf _ = orderingDataType
------------------------------------------------------------------------------
-leftConstr = mkDataCon eitherDataType "Left" Prefix
-rightConstr = mkDataCon eitherDataType "Right" Prefix
+leftConstr = mkConstr eitherDataType "Left" [] Prefix
+rightConstr = mkConstr eitherDataType "Right" [] Prefix
eitherDataType = mkDataType "Prelude.Either" [leftConstr,rightConstr]
instance (Data a, Data b) => Data (Either a b) where
gfoldl f z (Right a) = z Right `f` a
toConstr (Left _) = leftConstr
toConstr (Right _) = rightConstr
- fromConstr c = case conIndex c of
- 1 -> Left undefined
- 2 -> Right undefined
- _ -> error "fromConstr"
+ gunfold k z c = case constrIndex c of
+ 1 -> k (z Left)
+ 2 -> k (z Right)
+ _ -> error "gunfold"
dataTypeOf _ = eitherDataType
- cast0to2 = cast2
+ dataCast2 f = gcast2 f
------------------------------------------------------------------------------
instance (Data a, Data b) => Data (a -> b) where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "Prelude.(->)"
- cast0to2 = cast2
+ dataCast2 f = gcast2 f
------------------------------------------------------------------------------
-tuple0Constr = mkDataCon tuple0DataType "()" Prefix
+tuple0Constr = mkConstr tuple0DataType "()" [] Prefix
tuple0DataType = mkDataType "Prelude.()" [tuple0Constr]
instance Data () where
- toConstr _ = tuple0Constr
- fromConstr c | conIndex c == 1 = ()
- fromConstr _ = error "fromConstr"
- dataTypeOf _ = tuple0DataType
+ toConstr () = tuple0Constr
+ gunfold k z c | constrIndex c == 1 = z ()
+ gunfold _ _ _ = error "gunfold"
+ dataTypeOf _ = tuple0DataType
------------------------------------------------------------------------------
-tuple2Constr = mkDataCon tuple2DataType "(,)" Infix
+tuple2Constr = mkConstr tuple2DataType "(,)" [] Infix
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
- fromConstr c | conIndex c == 1 = (undefined,undefined)
- fromConstr _ = error "fromConstr"
- dataTypeOf _ = tuple2DataType
- cast0to2 = cast2
+ toConstr (a,b) = tuple2Constr
+ gunfold k z c | constrIndex c == 1 = k (k (z (,)))
+ gunfold _ _ _ = error "gunfold"
+ dataTypeOf _ = tuple2DataType
+ dataCast2 f = gcast2 f
------------------------------------------------------------------------------
-tuple3Constr = mkDataCon tuple3DataType "(,,)" Infix
+tuple3Constr = mkConstr tuple3DataType "(,,)" [] Infix
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
- fromConstr c | conIndex c == 1 = (undefined,undefined,undefined)
- fromConstr _ = error "fromConstr"
- dataTypeOf _ = tuple3DataType
+ toConstr (a,b,c) = tuple3Constr
+ gunfold k z c | constrIndex c == 1 = k (k (k (z (,,))))
+ gunfold _ _ _ = error "gunfold"
+ dataTypeOf _ = tuple3DataType
------------------------------------------------------------------------------
-tuple4Constr = mkDataCon tuple4DataType "(,,,)" Infix
+tuple4Constr = mkConstr tuple4DataType "(,,,)" [] Infix
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
- fromConstr c = case conIndex c of
- 1 -> (undefined,undefined,undefined,undefined)
- _ -> error "fromConstr"
+ toConstr (a,b,c,d) = tuple4Constr
+ gunfold k z c = case constrIndex c of
+ 1 -> k (k (k (k (z (,,,)))))
+ _ -> error "gunfold"
dataTypeOf _ = tuple4DataType
------------------------------------------------------------------------------
-tuple5Constr = mkDataCon tuple5DataType "(,,,,)" Infix
+tuple5Constr = mkConstr tuple5DataType "(,,,,)" [] Infix
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
- fromConstr c = case conIndex c of
- 1 -> (undefined,undefined,undefined,undefined,undefined)
- _ -> error "fromConstr"
+ toConstr (a,b,c,d,e) = tuple5Constr
+ gunfold k z c = case constrIndex c of
+ 1 -> k (k (k (k (k (z (,,,,))))))
+ _ -> error "gunfold"
dataTypeOf _ = tuple5DataType
------------------------------------------------------------------------------
-tuple6Constr = mkDataCon tuple6DataType "(,,,,,)" Infix
+tuple6Constr = mkConstr tuple6DataType "(,,,,,)" [] Infix
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
- fromConstr c =
- case conIndex c of
- 1 -> (undefined,undefined,undefined,undefined,undefined,undefined)
- _ -> error "fromConstr"
+ toConstr (a,b,c,d,e,f) = tuple6Constr
+ gunfold k z c = case constrIndex c of
+ 1 -> k (k (k (k (k (k (z (,,,,,)))))))
+ _ -> error "gunfold"
dataTypeOf _ = tuple6DataType
------------------------------------------------------------------------------
-tuple7Constr = mkDataCon tuple7DataType "(,,,,,,)" Infix
+tuple7Constr = mkConstr tuple7DataType "(,,,,,,)" [] Infix
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
- fromConstr c = case conIndex c of
- 1 -> (undefined,undefined,undefined,undefined,undefined,undefined,undefined)
- _ -> error "fromConstr"
+ toConstr (a,b,c,d,e,f,g) = 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"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "Data.Typeable.TypeRep"
instance Data TyCon where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "Data.Typeable.TyCon"
instance Data DataType where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "Data.Generics.Basics.DataType"
instance Typeable a => Data (IO a) where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "GHC.IOBase.IO"
instance Data Handle where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "GHC.IOBase.Handle"
instance Typeable a => Data (Ptr a) where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "GHC.Ptr.Ptr"
instance Typeable a => Data (StablePtr a) where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNorepType "GHC.Stable.StablePtr"
instance Typeable a => Data (IORef a) where
toConstr _ = error "toConstr"
- fromConstr _ = error "fromConstr"
+ 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"
+
projects / haskell-directory.git / blobdiff