Data and Typeable instances for immutable vectors
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Wed, 7 Apr 2010 02:44:50 +0000 (02:44 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Wed, 7 Apr 2010 02:44:50 +0000 (02:44 +0000)
Data/Vector.hs
Data/Vector/Generic.hs
Data/Vector/Primitive.hs
Data/Vector/Storable.hs
Data/Vector/Unboxed/Base.hs
vector.cabal

index 31fff91..d3cc78a 100644 (file)
@@ -139,14 +139,25 @@ import Prelude hiding ( length, null,
 
 import qualified Prelude
 
+import Data.Typeable ( Typeable )
+import Data.Data     ( Data(..) )
+
 -- | Boxed vectors, supporting efficient slicing.
 data Vector a = Vector {-# UNPACK #-} !Int
                        {-# UNPACK #-} !Int
                        {-# UNPACK #-} !(Array a)
+        deriving ( Typeable )
 
 instance Show a => Show (Vector a) where
     show = (Prelude.++ " :: Data.Vector.Vector") . ("fromList " Prelude.++) . show . toList
 
+instance Data a => Data (Vector a) where
+  gfoldl       = G.gfoldl
+  toConstr _   = error "toConstr"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = G.mkType "Data.Vector.Vector"
+  dataCast1    = G.dataCast
+
 type instance G.Mutable Vector = MVector
 
 instance G.Vector Vector a where
index c5d17fe..7be7582 100644 (file)
@@ -89,7 +89,10 @@ module Data.Vector.Generic (
   stream, unstream, streamR, unstreamR,
 
   -- * MVector-based initialisation
-  new
+  new,
+
+  -- * Utilities for defining Data instances
+  gfoldl, dataCast, mkType
 ) where
 
 import           Data.Vector.Generic.Mutable ( MVector )
@@ -119,6 +122,9 @@ import Prelude hiding ( length, null,
                         scanl, scanl1, scanr, scanr1,
                         enumFromTo, enumFromThenTo )
 
+import Data.Typeable ( Typeable1, gcast1 )
+import Data.Data ( Data, DataType, mkNoRepType )
+
 #include "vector.h"
 
 type family Mutable (v :: * -> *) :: * -> * -> *
@@ -1281,3 +1287,25 @@ fromListN :: Vector v a => Int -> [a] -> v a
 {-# INLINE fromListN #-}
 fromListN n = unstream . Stream.fromListN n
 
+-- Utilities for defining Data instances
+-- -------------------------------------
+
+-- | Generic definion of 'Data.Data.gfoldl' that views a 'Vector' as a
+-- list.
+gfoldl :: (Vector v a, Data a)
+       => (forall d b. Data d => c (d -> b) -> d -> c b)
+       -> (forall g. g -> c g)
+       -> v a
+       -> c (v a)
+{-# INLINE gfoldl #-}
+gfoldl f z v = z fromList `f` toList v
+
+mkType :: String -> DataType
+{-# INLINE mkType #-}
+mkType = mkNoRepType
+
+dataCast :: (Vector v a, Data a, Typeable1 v, Typeable1 t)
+         => (forall d. Data  d => c (t d)) -> Maybe  (c (v a))
+{-# INLINE dataCast #-}
+dataCast f = gcast1 f
+
index 4f6bb92..ed45d3c 100644 (file)
@@ -101,14 +101,26 @@ import Prelude hiding ( length, null,
 
 import qualified Prelude
 
+import Data.Typeable ( Typeable )
+import Data.Data     ( Data(..) )
+
 -- | Unboxed vectors of primitive types
 data Vector a = Vector {-# UNPACK #-} !Int
                        {-# UNPACK #-} !Int
                        {-# UNPACK #-} !ByteArray
+  deriving ( Typeable )
 
 instance (Show a, Prim a) => Show (Vector a) where
     show = (Prelude.++ " :: Data.Vector.Primitive.Vector") . ("fromList " Prelude.++) . show . toList
 
+instance (Data a, Prim a) => Data (Vector a) where
+  gfoldl       = G.gfoldl
+  toConstr _   = error "toConstr"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = G.mkType "Data.Vector.Primitive.Vector"
+  dataCast1    = G.dataCast
+
+
 type instance G.Mutable Vector = MVector
 
 instance Prim a => G.Vector Vector a where
index b9e3b3f..06da772 100644 (file)
@@ -108,12 +108,16 @@ import Prelude hiding ( length, null,
 
 import qualified Prelude
 
+import Data.Typeable ( Typeable )
+import Data.Data     ( Data(..) )
+
 #include "vector.h"
 
 -- | 'Storable'-based vectors
 data Vector a = Vector {-# UNPACK #-} !(Ptr a)
                        {-# UNPACK #-} !Int
                        {-# UNPACK #-} !(ForeignPtr a)
+        deriving ( Typeable )
 
 instance (Show a, Storable a) => Show (Vector a) where
   show = (Prelude.++ " :: Data.Vector.Storable.Vector")
@@ -121,6 +125,13 @@ instance (Show a, Storable a) => Show (Vector a) where
        . show
        . toList
 
+instance (Data a, Storable a) => Data (Vector a) where
+  gfoldl       = G.gfoldl
+  toConstr _   = error "toConstr"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = G.mkType "Data.Vector.Storable.Vector"
+  dataCast1    = G.dataCast
+
 type instance G.Mutable Vector = MVector
 
 instance Storable a => G.Vector Vector a where
index 8ac2a80..21a842a 100644 (file)
@@ -29,6 +29,9 @@ import Data.Word ( Word, Word8, Word16, Word32, Word64 )
 import Data.Int  ( Int8, Int16, Int32, Int64 )
 import Data.Complex
 
+import Data.Typeable ( Typeable1(..), mkTyConApp, mkTyCon )
+import Data.Data     ( Data(..) )
+
 #include "vector.h"
 
 data family MVector s a
@@ -41,6 +44,22 @@ type instance G.Mutable Vector = MVector
 
 class (G.Vector Vector a, M.MVector MVector a) => Unbox a
 
+-- -----------------
+-- Data and Typeable
+-- -----------------
+
+vectorTy :: String
+vectorTy = "Data.Vector.Unboxed.Vector"
+
+instance Typeable1 Vector where
+  typeOf1 _ = mkTyConApp (mkTyCon vectorTy) []
+
+instance (Data a, Unbox a) => Data (Vector a) where
+  gfoldl       = G.gfoldl
+  toConstr _   = error "toConstr"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = G.mkType vectorTy
+  dataCast1    = G.dataCast
 
 -- ----
 -- Unit
index 9c24be3..6e47357 100644 (file)
@@ -75,7 +75,7 @@ Flag InternalChecks
 
 
 Library
-  Extensions: CPP
+  Extensions: CPP, DeriveDataTypeable
   Exposed-Modules:
         Data.Vector.Internal.Check