Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add Storable instances and default implementations

  • Loading branch information...
commit 1ca7fd258b8ebe96e296f89d5c9fa993726cd799 1 parent 837aaee
@Shimuuar authored
View
7 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
View
38 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,6 +168,8 @@ 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,
@@ -169,7 +177,7 @@ import Data.Vector.Fixed.Cont (Vector(..),VectorN,Dim,length,ContVec,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)
View
12 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 #-}
+
View
39 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
@@ -587,6 +589,37 @@ 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
convert :: (Vector v a, Vector w a, Dim v ~ Dim w) => v a -> w a
{-# INLINE convert #-}
View
10 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 #-}
View
15 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 #-}
+
----------------------------------------------------------------
Please sign in to comment.
Something went wrong with that request. Please try again.