Add Storable instances and default implementations

fixed-vector/ChangeLog

@@ -1,8 +1,11 @@
 Changes in 0.8.0.0
 
-  * NFData instances for all data type
+  * NFData instances for all data type.
 
-  * {i,}zipWith3 and {i,}zipWithM_ added
+  * Storable instances for all data types and default implementation of
+    Storable's methods added.
+
+  * {i,}zipWith3 and {i,}zipWithM_ added.
 
 
 Changes in 0.7.0.3

fixed-vector/Data/Vector/Fixed.hs

@@ -138,6 +138,12 @@ module Data.Vector.Fixed (
   , izipWith3
   , izipWithM
   , izipWithM_
+    -- * Storable methods
+    -- $storable
+  , defaultAlignemnt
+  , defaultSizeOf
+  , defaultPeek
+  , defaultPoke
     -- * Conversion
   , convert
   , toList
@@ -162,14 +168,16 @@ import Data.Data           (Typeable,Data)
 import Data.Monoid         (Monoid(..))
 import qualified Data.Foldable    as F
 import qualified Data.Traversable as T
+import Foreign.Storable (Storable(..))
+import Foreign.Ptr      (Ptr,castPtr)
 
 import Data.Vector.Fixed.Cont     (Vector(..),VectorN,Dim,length,ContVec,vector,
                                    empty,S,Z,Arity,Fun(..),accum,apply,
                                    N1,N2,N3,N4,N5,N6,vector)
 import qualified Data.Vector.Fixed.Cont as C
 import Data.Vector.Fixed.Internal
 
-import Prelude (Show(..),Eq(..),Ord(..),Functor(..),id,(.),($),seq)
+import Prelude (Show(..),Eq(..),Ord(..),Functor(..),id,(.),($),seq,undefined)
 -- Needed for doctest
 import Prelude (Char)
 
@@ -215,6 +223,12 @@ import Prelude (Char)
 -- Constructors for vectors with small dimensions.
 
 
+-- $storable
+--
+-- Default implementation of methods for Storable type class assumes
+-- that individual elements of vector are stored as N-element array.
+
+
 
 --------------------------------------------------------------------------------
 -- We are trying to be clever with indexing here. It's not possible to
@@ -295,6 +309,17 @@ instance (Arity n, Monoid a) => Monoid (VecList n a) where
   {-# INLINE mempty  #-}
   {-# INLINE mappend #-}
 
+instance (Storable a, Arity n) => Storable (VecList n a) where
+  alignment = defaultAlignemnt
+  sizeOf    = defaultSizeOf
+  peek      = defaultPeek
+  poke      = defaultPoke
+  {-# INLINE alignment #-}
+  {-# INLINE sizeOf    #-}
+  {-# INLINE peek      #-}
+  {-# INLINE poke      #-}
+
+
 
 -- | Single-element tuple.
 newtype Only a = Only a
@@ -322,6 +347,17 @@ instance Vector Only a where
   {-# INLINE construct #-}
   {-# INLINE inspect   #-}
 
+instance (Storable a) => Storable (Only a) where
+  alignment _ = alignment (undefined :: a)
+  sizeOf    _ = sizeOf    (undefined :: a)
+  peek p          = Only <$> peek (castPtr p)
+  poke p (Only a) = poke (castPtr p) a
+  {-# INLINE alignment #-}
+  {-# INLINE sizeOf    #-}
+  {-# INLINE peek      #-}
+  {-# INLINE poke      #-}
+
+
 -- | Empty tuple.
 data Empty a = Empty deriving (Typeable, Data)
 

fixed-vector/Data/Vector/Fixed/Boxed.hs

@@ -26,6 +26,7 @@ import Data.Monoid          (Monoid(..))
 import Data.Data
 import qualified Data.Foldable    as F
 import qualified Data.Traversable as T
+import Foreign.Storable (Storable(..))
 import Prelude (Show(..),Eq(..),Ord(..),Functor(..),Monad(..))
 import Prelude ((++),($),($!),undefined,error,seq)
 
@@ -66,13 +67,22 @@ instance (Typeable n, Arity n, Data a) => Data (Vec n a) where
   toConstr   _ = con_Vec
   dataTypeOf _ = ty_Vec
 
-
 ty_Vec :: DataType
 ty_Vec  = mkDataType "Data.Vector.Fixed.Boxed.Vec" [con_Vec]
 
 con_Vec :: Constr
 con_Vec = mkConstr ty_Vec "Vec" [] Prefix
 
+instance (Storable a, Arity n) => Storable (Vec n a) where
+  alignment = defaultAlignemnt
+  sizeOf    = defaultSizeOf
+  peek      = defaultPeek
+  poke      = defaultPoke
+  {-# INLINE alignment #-}
+  {-# INLINE sizeOf    #-}
+  {-# INLINE peek      #-}
+  {-# INLINE poke      #-}
+
 
 
 

fixed-vector/Data/Vector/Fixed/Internal.hs

@@ -1,9 +1,10 @@
-{-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE Rank2Types            #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
 -- |
 -- Implementation of fixed-vectors
 module Data.Vector.Fixed.Internal where
@@ -13,7 +14,8 @@ import Control.Monad       (liftM)
 import Data.Monoid         (Monoid(..))
 import qualified Data.Foldable    as T
 import qualified Data.Traversable as T
-
+import Foreign.Storable (Storable(..))
+import Foreign.Ptr      (Ptr,castPtr)
 
 import Data.Vector.Fixed.Cont     (Vector(..),Dim,S,Z,Arity,vector,Add)
 import qualified Data.Vector.Fixed.Cont as C
@@ -585,6 +587,37 @@ izipWithM_
 izipWithM_ f xs ys = C.izipWithM_ f (C.cvec xs) (C.cvec ys)
 
 
+----------------------------------------------------------------
+
+-- | Default implementation of 'alignment' for 'Storable' type class
+--   for fixed vectors.
+defaultAlignemnt :: forall a v. Storable a => v a -> Int
+defaultAlignemnt _ = alignment (undefined :: a)
+{-# INLINE defaultAlignemnt #-}
+
+-- | Default implementation of 'sizeOf` for 'Storable' type class for
+--   fixed vectors
+defaultSizeOf
+  :: forall a v. (Storable a, Vector v a)
+  => v a -> Int
+defaultSizeOf _ = sizeOf (undefined :: a) * C.arity (undefined :: Dim v)
+{-# INLINE defaultSizeOf #-}
+
+-- | Default implementation of 'peek' for 'Storable' type class for
+--   fixed vector
+defaultPeek :: (Storable a, Vector v a) => Ptr (v a) -> IO (v a)
+{-# INLINE defaultPeek #-}
+defaultPeek ptr
+  = generateM (peekElemOff (castPtr ptr))
+
+-- | Default implementation of 'poke' for 'Storable' type class for
+--   fixed vector
+defaultPoke :: (Storable a, Vector v a) => Ptr (v a) -> v a -> IO ()
+{-# INLINE defaultPoke #-}
+defaultPoke ptr
+  = imapM_ (pokeElemOff (castPtr ptr))
+
+
 ----------------------------------------------------------------
 
 -- | Convert between different vector types

fixed-vector/Data/Vector/Fixed/Primitive.hs

@@ -29,6 +29,7 @@ import Data.Data
 import Data.Monoid              (Monoid(..))
 import Data.Primitive.ByteArray
 import Data.Primitive
+import qualified Foreign.Storable as Foreign (Storable(..))
 import Prelude (Show(..),Eq(..),Ord(..),Num(..))
 import Prelude ((++),($),($!),undefined,seq)
 
@@ -141,3 +142,12 @@ ty_Vec  = mkDataType "Data.Vector.Fixed.Primitive.Vec" [con_Vec]
 con_Vec :: Constr
 con_Vec = mkConstr ty_Vec "Vec" [] Prefix
 
+instance (Foreign.Storable a, Prim a, Arity n) => Foreign.Storable (Vec n a) where
+  alignment = defaultAlignemnt
+  sizeOf    = defaultSizeOf
+  peek      = defaultPeek
+  poke      = defaultPoke
+  {-# INLINE alignment #-}
+  {-# INLINE sizeOf    #-}
+  {-# INLINE peek      #-}
+  {-# INLINE poke      #-}

fixed-vector/Data/Vector/Fixed/Unboxed.hs

@@ -30,10 +30,13 @@ import Data.Monoid     (Monoid(..))
 import Data.Data
 import Data.Int        (Int8, Int16, Int32, Int64 )
 import Data.Word       (Word,Word8,Word16,Word32,Word64)
+import Foreign.Storable (Storable(..))
 import Prelude (Show(..),Eq(..),Ord(..),Int,Double,Float,Char,Bool(..))
 import Prelude ((++),(||),($),(.),seq)
 
-import Data.Vector.Fixed (Dim,Vector(..),VectorN,S,Z,toList,eq,ord,replicate,zipWith,foldl)
+import Data.Vector.Fixed (Dim,Vector(..),VectorN,S,Z,toList,eq,ord,replicate,zipWith,foldl,
+                          defaultSizeOf,defaultAlignemnt,defaultPeek,defaultPoke
+                         )
 import Data.Vector.Fixed.Mutable
 import qualified Data.Vector.Fixed.Cont      as C
 import qualified Data.Vector.Fixed.Primitive as P
@@ -116,6 +119,16 @@ ty_Vec  = mkDataType "Data.Vector.Fixed.Unboxed.Vec" [con_Vec]
 con_Vec :: Constr
 con_Vec = mkConstr ty_Vec "Vec" [] Prefix
 
+instance (Storable a, Unbox n a) => Storable (Vec n a) where
+  alignment = defaultAlignemnt
+  sizeOf    = defaultSizeOf
+  peek      = defaultPeek
+  poke      = defaultPoke
+  {-# INLINE alignment #-}
+  {-# INLINE sizeOf    #-}
+  {-# INLINE peek      #-}
+  {-# INLINE poke      #-}
+
 
 
 ----------------------------------------------------------------