Added quite a few more Data instances.
For these datatypes:
- Data.Array
- Data.FiniteMap
- Data.IntMap
- Data.IntSet
- Data.Map
- Data.Set
- GHC.ST
- GHC.ForeignPtr
- Control.Concurrent.MVar and friends
(In some cases, this also required adding Typeable instances.)
Most or all additions have been tagged by
#ifdef __GLASGOW_HASKELL__ ...
For the _abstract_ datatypes in the above list,
we use the from... and to... projections and injections
so that we can process the containers or whatever as lists.
We don't provide the reflection API for abstract datatypes.
If anyone sees Data-wanting datatypes in the base or elsewhere
in the module space, please let me know, or please go ahead,
and add coverage for SYB. As far as I understand, the base
code cannot use "deriving (Typeable, Data)", whereas this
is very well an option for non-base modules. Indeed it is
readily done like this in:
- network/Network/URI
- haskell-src
import Data.Ix
#ifdef __GLASGOW_HASKELL__
-import GHC.Arr -- Most of the hard work is done here
-import GHC.Err ( undefined )
+import GHC.Arr -- Most of the hard work is done here
+import Data.Generics.Basics -- To provide a Data instance
+import Data.Generics.Instances -- To provide a Data instance
+import GHC.Err ( error ) -- Needed for Data instance
#endif
#ifdef __HUGS__
INSTANCE_TYPEABLE2(Array,arrayTc,"Array")
#endif
+#ifdef __GLASGOW_HASKELL__
+
+-- This instance 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"
+
+#endif
+
{- $intro
Haskell provides indexable /arrays/, which may be thought of as functions
whose domains are isomorphic to contiguous subsets of the integers.
import Data.Maybe ( isJust )
#ifdef __GLASGOW_HASKELL__
import GHC.Base
+import Data.Typeable
+import Data.Generics.Basics
+import Data.Generics.Instances
#endif
#ifdef __HADDOCK__
#endif /* not GHC */
+
-- ---------------------------------------------------------------------------
-- The signature of the module
instance Functor (FiniteMap k) where
fmap f = mapFM (const f)
+#if __GLASGOW_HASKELL__
+
+#include "Typeable.h"
+INSTANCE_TYPEABLE2(FiniteMap,arrayTc,"FiniteMap")
+
+-- This instance preserves data abstraction at the cost of inefficiency.
+-- We omit reflection services for the sake of data abstraction.
+
+instance (Data a, Data b, Ord a) => Data (FiniteMap a b) where
+ gfoldl f z fm = z listToFM `f` (fmToList fm)
+ toConstr _ = error "toConstr"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNorepType "Data.Array.Array"
+
+#endif
+
+
-- ---------------------------------------------------------------------------
-- Adding to and deleting from @FiniteMaps@
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.
#include "Typeable.h"
------------------------------------------------------------------------------
+
+
+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"
+
+
+------------------------------------------------------------------------------
import qualified List
-}
+#if __GLASGOW_HASKELL__
+import Data.Generics.Basics
+import Data.Generics.Instances
+#endif
+
#if __GLASGOW_HASKELL__ >= 503
import GHC.Word
import GHC.Exts ( Word(..), Int(..), shiftRL# )
type Key = Int
{--------------------------------------------------------------------
+ A Data instance
+--------------------------------------------------------------------}
+
+#if __GLASGOW_HASKELL__
+
+-- This instance preserves data abstraction at the cost of inefficiency.
+-- We omit reflection services for the sake of data abstraction.
+
+instance Data a => Data (IntMap a) where
+ gfoldl f z im = z fromList `f` (toList im)
+ toConstr _ = error "toConstr"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNorepType "Data.IntMap.IntMap"
+
+#endif
+
+{--------------------------------------------------------------------
Query
--------------------------------------------------------------------}
-- | /O(1)/. Is the map empty?
import qualified List
-}
+#if __GLASGOW_HASKELL__
+import Data.Generics.Basics
+import Data.Generics.Instances
+#endif
+
#if __GLASGOW_HASKELL__ >= 503
import GHC.Word
import GHC.Exts ( Word(..), Int(..), shiftRL# )
type Mask = Int
{--------------------------------------------------------------------
+ A Data instance
+--------------------------------------------------------------------}
+
+#if __GLASGOW_HASKELL__
+
+-- This instance preserves data abstraction at the cost of inefficiency.
+-- We omit reflection services for the sake of data abstraction.
+
+instance Data IntSet where
+ gfoldl f z is = z fromList `f` (toList is)
+ toConstr _ = error "toConstr"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNorepType "Data.IntSet.IntSet"
+
+#endif
+
+{--------------------------------------------------------------------
Query
--------------------------------------------------------------------}
-- | /O(1)/. Is the set empty?
import List(nub,sort)
-}
+#if __GLASGOW_HASKELL__
+import Data.Generics.Basics
+import Data.Generics.Instances
+#endif
+
{--------------------------------------------------------------------
Operators
--------------------------------------------------------------------}
type Size = Int
{--------------------------------------------------------------------
+ A Data instance
+--------------------------------------------------------------------}
+
+#if __GLASGOW_HASKELL__
+
+-- This instance preserves data abstraction at the cost of inefficiency.
+-- We omit reflection services for the sake of data abstraction.
+
+instance (Data k, Data a, Ord k) => Data (Map k a) where
+ gfoldl f z map = z fromList `f` (toList map)
+ toConstr _ = error "toConstr"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNorepType "Data.Map.Map"
+
+#endif
+
+{--------------------------------------------------------------------
Query
--------------------------------------------------------------------}
-- | /O(1)/. Is the map empty?
import qualified List
-}
+#if __GLASGOW_HASKELL__
+import Data.Generics.Basics
+import Data.Generics.Instances
+#endif
+
{--------------------------------------------------------------------
Operators
--------------------------------------------------------------------}
type Size = Int
{--------------------------------------------------------------------
+ A Data instance
+--------------------------------------------------------------------}
+
+#if __GLASGOW_HASKELL__
+
+-- This instance preserves data abstraction at the cost of inefficiency.
+-- We omit reflection services for the sake of data abstraction.
+
+instance (Data a, Ord a) => Data (Set a) where
+ gfoldl f z set = z fromList `f` (toList set)
+ toConstr _ = error "toConstr"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNorepType "Data.Set.Set"
+
+#endif
+
+{--------------------------------------------------------------------
Query
--------------------------------------------------------------------}
-- | /O(1)/. Is this the empty set?
import GHC.IOBase
import GHC.ST -- So we can give Typeable instance for ST
import GHC.Ptr -- So we can give Typeable instance for Ptr
+import GHC.ForeignPtr -- So we can give Typeable instance for ForeignPtr
import GHC.Stable -- So we can give Typeable instance for StablePtr
#endif
INSTANCE_TYPEABLE1(IO,ioTc,"IO")
#ifdef __GLASGOW_HASKELL__
INSTANCE_TYPEABLE2(ST,stTc,"ST")
+INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")
#endif
INSTANCE_TYPEABLE0((),unitTc,"()")
#ifndef __NHC__
#ifdef __GLASGOW_HASKELL__
INSTANCE_TYPEABLE0(RealWorld,realWorldTc,"RealWorld")
-INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" )
#endif
---------------------------------------------
import GHC.Pack ( packCString# )
import GHC.Ptr ( Ptr(..), plusPtr, FunPtr(..) )
import GHC.STRef
+import Data.Typeable
+#include "Typeable.h"
infixr 0 `par`, `pseq`
\end{code}
it defines 'ThreadId' as a synonym for ().
-}
+INSTANCE_TYPEABLE0(ThreadId,threadIdTc,"ThreadId")
+
+
--forkIO has now been hoisted out into the Concurrent library.
{- | 'killThread' terminates the given thread (GHC only).
\begin{code}
newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #))
+INSTANCE_TYPEABLE1(STM,stmTc,"STM" )
+
unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #))
unSTM (STM a) = a
data TVar a = TVar (TVar# RealWorld a)
+INSTANCE_TYPEABLE1(TVar,tvarTc,"TVar" )
+
instance Eq (TVar a) where
(TVar tvar1#) == (TVar tvar2#) = sameTVar# tvar1# tvar2#
\begin{code}
--Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
+INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" )
+
-- |Create an 'MVar' which is initially empty.
newEmptyMVar :: IO (MVar a)
newEmptyMVar = IO $ \ s# ->
import Control.Monad ( sequence_ )
import Foreign.Ptr
import Foreign.Storable
-import Data.Typeable
import GHC.List ( null )
import GHC.Base
instance Show (ForeignPtr a) where
showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f)
-#include "Typeable.h"
-INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")
-
-- |A Finalizer is represented as a pointer to a foreign function that, at
-- finalisation time, gets as an argument a plain pointer variant of the
-- foreign pointer that the finalizer is associated with.