Adventures with the vector package

test.hs

{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}

module Main
    where

import Control.Monad ( liftM )
import Data.Char
import qualified Data.Vector.Unboxed         as V
import Data.Vector.Generic         as G
import qualified Data.Vector.Generic.Mutable as M

data Point = Pt {-# UNPACK #-} !Float
    {-# UNPACK #-} !Float
    {-# UNPACK #-} !Float

-- Necessary boilerplate to make Data.Vector.Unboxed play nice with our
-- datatype.
type Float3 = (Float, Float, Float)

makePoint :: Float3 -> Point
makePoint (x,y,z) = Pt x y z

newtype instance V.MVector s Point = MV_Point (V.MVector s Float3)
newtype instance V.Vector    Point = V_Point  (V.Vector    Float3)

instance V.Unbox Point

instance M.MVector V.MVector Point where
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicOverlaps #-}
  {-# INLINE basicUnsafeNew #-}
  {-# INLINE basicUnsafeNewWith #-}
  {-# INLINE basicUnsafeRead #-}
  {-# INLINE basicUnsafeWrite #-}
  {-# INLINE basicClear #-}
  {-# INLINE basicSet #-}
  {-# INLINE basicUnsafeCopy #-}
  {-# INLINE basicUnsafeGrow #-}
  basicLength (MV_Point v) = M.basicLength v
  basicUnsafeSlice i n (MV_Point v) = MV_Point $ M.basicUnsafeSlice i n v
  basicOverlaps (MV_Point v1) (MV_Point v2) = M.basicOverlaps v1 v2
  basicUnsafeNew n = MV_Point `liftM` M.basicUnsafeNew n
  basicUnsafeNewWith n (Pt x y z) =
      MV_Point `liftM` M.basicUnsafeNewWith n (x,y,z)
  basicUnsafeRead (MV_Point v) i = makePoint `liftM` M.basicUnsafeRead v i
  basicUnsafeWrite (MV_Point v) i (Pt x y z) = M.basicUnsafeWrite v i (x,y,z)
  basicClear (MV_Point v) = M.basicClear v
  basicSet (MV_Point v) (Pt x y z) = M.basicSet v (x,y,z)
  basicUnsafeCopy (MV_Point v1) (MV_Point v2) = M.basicUnsafeCopy v1 v2
  basicUnsafeGrow (MV_Point v) n = MV_Point `liftM` M.basicUnsafeGrow v n

instance G.Vector V.Vector Point where
  {-# INLINE unsafeFreeze #-}
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicUnsafeIndexM #-}
  {-# INLINE elemseq #-}
  unsafeFreeze (MV_Point v) = V_Point `liftM` G.unsafeFreeze v
  basicLength (V_Point v) = G.basicLength v
  basicUnsafeSlice i n (V_Point v) = V_Point $ G.basicUnsafeSlice i n v
  basicUnsafeIndexM (V_Point v) i
                = makePoint `liftM` G.basicUnsafeIndexM v i
  basicUnsafeCopy (MV_Point mv) (V_Point v) = G.basicUnsafeCopy mv v
  elemseq _ (Pt x y z) b = G.elemseq (undefined :: V.Vector a) x
                           $ G.elemseq (undefined :: V.Vector a) y
                           $ G.elemseq (undefined :: V.Vector a) z b

-- Client code.
a :: V.Vector Point
a = V.generate 1000000 (\x -> let x' = fromIntegral x in
                              (Pt (x'+0.1) (x'+0.2) (x'+0.3)))

my_sum :: V.Vector Point -> Float -> Float
my_sum l acc = V.foldl' (\acc' (Pt x y z) -> (acc' + x + y + z)) acc l

main :: IO ()
main = do
    print $ (my_sum a 0.0)
    c <- getChar -- Pause.
    print $ (my_sum a (fromInteger  $ fromIntegral (ord c)))