module Foreign.Marshal.StaticVector
( StaticVector
, toVector
, staticBounds
, staticSize
, fromList
) where
import Control.Monad
import Data.Functor ((<$>))
import Data.Ix
import Data.Ix.Static
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Storable.Mutable as VSM
import Data.Proxy
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
newtype StaticVector backing dimensions (elements :: *) =
StaticVector {
toVector :: backing elements
}
deriving (Eq)
instance (VG.Vector b e, Show e) => Show (StaticVector b d e) where
show = ("fromList " ++) . show . VG.toList . toVector
staticBounds :: forall b d e. IxStatic d =>
StaticVector b d e -> (Index d, Index d)
staticBounds _ = proxy taggedBounds (Proxy :: Proxy d)
staticSize :: IxStatic d => StaticVector b d e -> Int
staticSize = rangeSize . staticBounds
fromList :: (VG.Vector b e, IxStatic d) => [e] -> StaticVector b d e
fromList els | null els = error "empty input to fromList"
| otherwise = sv
where
size = staticSize sv
sv = StaticVector . VG.fromListN size . cycle $ els
instance (IxStatic d, Storable e, VG.Vector b e) =>
Storable (StaticVector b d e) where
sizeOf a = sizeOf (undefined :: e) * staticSize a
alignment _ = alignment (undefined :: e)
poke dst' sv@(StaticVector v) = do
let upper = staticSize sv 1
dst = castPtr dst'
forM_ [0..upper] $ \i -> poke (advancePtr dst i) $ VG.unsafeIndex v i
peek src' = do
rec let size = staticSize sv
v <- VGM.unsafeNew size
let src = castPtr src'
forM_ [0 .. size 1] $ \i -> do
x <- peek $ advancePtr src i
VGM.unsafeWrite v i x
sv <- StaticVector <$> VG.unsafeFreeze v
return sv
instance (IxStatic d, Storable e) =>
Storable (StaticVector VS.Vector d e) where
sizeOf a = sizeOf (undefined :: e) * staticSize a
alignment _ = alignment (undefined :: e)
poke dst sv@(StaticVector v) = do
VS.unsafeWith v $ \src -> copyBytes dst (castPtr src) $ sizeOf sv
peek src = do
rec let size = staticSize sv
v <- VSM.unsafeNew size
VSM.unsafeWith v $ \dst -> copyBytes (castPtr dst) src $ sizeOf sv
sv <- StaticVector <$> VG.unsafeFreeze v
return sv