Skip to content
Browse files

Implement alignment 'inheritance'

Previously, there was no way for a function taking an 8-byte aligned
vector to accept a 16-byte aligned vector, whilst it should (since it'd
also be 8-byte aligned as well, obviously).

This commit changes things a bit so this is possible now (at least for
power-of-two alignment values, which should suit our needs).

Thanks to Gábor Lehel on `Haskell Cafe`_.

.. _Haskell Cafe: http://www.haskell.org/pipermail/haskell-cafe/2012-July/102192.html
  • Loading branch information...
1 parent 4c80959 commit a4f13745eb24d87a3628af13109f3e1d8232c925 @NicolasT committed Jul 8, 2012
Showing with 55 additions and 11 deletions.
  1. +14 −4 benchmark/xor.hs
  2. +3 −2 src/Data/Vector/SIMD.hs
  3. +8 −1 src/Data/Vector/SIMD/Algorithms.hs
  4. +30 −4 src/Data/Vector/SIMD/Mutable.hs
View
18 benchmark/xor.hs
@@ -76,7 +76,7 @@ main = do
!(!sv1024a, !sv1024b) = gen SV.fromListN 1024
!(!sv4096a, !sv4096b) = gen SV.fromListN 4096
- mv1024a, mv1024b, mv4096a, mv4096b :: MV.Vector MV.A16 Word8
+ mv1024a, mv1024b, mv4096a, mv4096b :: MV.Vector MV.A32 Word8
!(!mv1024a, !mv1024b) = gen MV.fromListN 1024
!(!mv4096a, !mv4096b) = gen MV.fromListN 4096
@@ -105,14 +105,24 @@ benchSV !a !b = r
!r = SV.zipWith xor a b
{-# INLINE r #-}
-benchMV :: MV.Vector MV.A16 Word8 -> MV.Vector MV.A16 Word8 -> MV.Vector MV.A16 Word8
+benchMV :: MV.Vector MV.A32 Word8 -> MV.Vector MV.A32 Word8 -> MV.Vector MV.A32 Word8
benchMV !a !b = r
where
- r :: MV.Vector MV.A16 Word8
+ r :: MV.Vector MV.A32 Word8
!r = MV.zipWith xor a b
{-# INLINE r #-}
-benchMVA :: MV.Vector MV.A16 Word8 -> MV.Vector MV.A16 Word8 -> MV.Vector MV.A16 Word8
+-- unsafeXorSSE42 is typed
+-- unsafeXorSSE42 :: (Storable a,
+-- MSV.AlignedToAtLeast MSV.A16 o1, MSV.Alignment o1,
+-- MSV.AlignedToAtLeast MSV.A16 o2, MSV.Alignment o2,
+-- MSV.AlignedToAtLeast MSV.A16 o3, MSV.Alignment o3) =>
+-- SV.Vector o1 a -> SV.Vector o2 a -> SV.Vector o3 a
+-- We restrict the type of benchMVA just a little more, to show how A32 is
+-- compatible with the requested A16 (as intended).
+-- The result is of a different type though, imagining we only need a 16-byte
+-- aligned vector further on for some random reason
+benchMVA :: MV.Vector MV.A32 Word8 -> MV.Vector MV.A32 Word8 -> MV.Vector MV.A16 Word8
benchMVA !a !b = r
where
r :: MV.Vector MV.A16 Word8
View
5 src/Data/Vector/SIMD.hs
@@ -19,7 +19,8 @@
{-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
module Data.Vector.SIMD (
- Vector, A8, A16,
+ Vector,
+ Alignment, AlignedToAtLeast, A1, A2, A4, A8, A16, A32,
fromListN,
length,
unsafeWith,
@@ -40,7 +41,7 @@ import Data.Typeable (Typeable)
import Control.Monad.Primitive
-import Data.Vector.SIMD.Mutable (MVector(..), Alignment, A8, A16)
+import Data.Vector.SIMD.Mutable (MVector(..), Alignment, AlignedToAtLeast, A1, A2, A4, A8, A16, A32)
import Prelude hiding (length, zipWith)
View
9 src/Data/Vector/SIMD/Algorithms.hs
@@ -17,6 +17,7 @@
-}
{-# LANGUAGE BangPatterns, ForeignFunctionInterface, ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
module Data.Vector.SIMD.Algorithms (
unsafeXorSSE42
@@ -40,7 +41,11 @@ import qualified Data.Vector.SIMD.Mutable as MSV
foreign import ccall unsafe "_vector_simd_xor_sse42" _c_xor_sse42
:: Ptr a -> Ptr a -> Ptr a -> CSize -> IO ()
-unsafeXorSSE42 :: Storable a => SV.Vector SV.A16 a -> SV.Vector SV.A16 a -> SV.Vector SV.A16 a
+unsafeXorSSE42 :: (Storable a,
+ SV.AlignedToAtLeast SV.A16 o1, SV.Alignment o1,
+ SV.AlignedToAtLeast SV.A16 o2, SV.Alignment o2,
+ SV.AlignedToAtLeast SV.A16 o3, SV.Alignment o3) =>
+ SV.Vector o1 a -> SV.Vector o2 a -> SV.Vector o3 a
unsafeXorSSE42 !a !b = unsafePerformIO $ do
let l = SV.length a
--bl = l * (sizeOf (undefined :: a))
@@ -55,3 +60,5 @@ unsafeXorSSE42 !a !b = unsafePerformIO $ do
SV.unsafeFreeze n
{-# INLINE unsafeXorSSE42 #-}
+{-# SPECIALIZE unsafeXorSSE42 ::
+ SV.Vector SV.A16 Word8 -> SV.Vector SV.A16 Word8 -> SV.Vector SV.A16 Word8 #-}
View
34 src/Data/Vector/SIMD/Mutable.hs
@@ -18,16 +18,19 @@
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables, ForeignFunctionInterface, EmptyDataDecls #-}
+{-# LANGUAGE TypeSynonymInstances, FlexibleContexts #-}
module Data.Vector.SIMD.Mutable (
MVector(..), IOVector, STVector,
- Alignment, A8, A16,
+ AlignedToAtLeast, Alignment, A1, A2, A4, A8, A16, A32,
new,
unsafeWith
) where
import qualified Data.Vector.Generic.Mutable as G
+import qualified Data.Word as W
+
import Foreign.Storable hiding (alignment)
import Foreign.ForeignPtr
import Foreign.Ptr (Ptr, nullPtr)
@@ -54,13 +57,33 @@ type STVector o s = MVector o s
class Alignment o where
alignment :: o -> Int
-data A8
+data One
+data Twice n
+
+class AlignedToAtLeast n a
+instance AlignedToAtLeast One One
+instance AlignedToAtLeast One (Twice a)
+instance AlignedToAtLeast n a => AlignedToAtLeast (Twice n) (Twice a)
+
+type A1 = One
+type A2 = Twice A1
+type A4 = Twice A2
+type A8 = Twice A4
+type A16 = Twice A8
+type A32 = Twice A16
+
+instance Alignment A1 where
+ alignment _ = 1
+instance Alignment A2 where
+ alignment _ = 2
+instance Alignment A4 where
+ alignment _ = 4
instance Alignment A8 where
alignment _ = 8
-
-data A16
instance Alignment A16 where
alignment _ = 16
+instance Alignment A32 where
+ alignment _ = 32
instance (Storable a, Alignment o) => G.MVector (MVector o) a where
basicLength (MVector n _) = n
@@ -83,6 +106,8 @@ instance (Storable a, Alignment o) => G.MVector (MVector o) a where
fp <- mallocVector n (undefined :: o)
return $ MVector n fp
{-# INLINE basicUnsafeNew #-}
+ {-# SPECIALIZE basicUnsafeNew ::
+ (Storable a, PrimMonad m) => Int -> m (MVector A16 (PrimState m) a) #-}
basicUnsafeRead (MVector _ fp) i =
unsafePrimToPrim $ withForeignPtr fp (`peekElemOff` i)
@@ -120,6 +145,7 @@ mallocVector = doMalloc undefined
else newForeignPtr finalizer_mm_free ptr
{-# INLINE doMalloc #-}
{-# INLINE mallocVector #-}
+{-# SPECIALIZE mallocVector :: Int -> A16 -> IO (ForeignPtr W.Word8) #-}
new :: (PrimMonad m, Storable a, Alignment o) => Int -> m (MVector o (PrimState m) a)
new = G.new

0 comments on commit a4f1374

Please sign in to comment.
Something went wrong with that request. Please try again.