{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE CPP #-}
module Data.Vector.SEXP.Mutable.Internal
( MVector(..)
, W(..)
, withW
, proxyW
, unsafeToPtr
, release
, unsafeRelease
) where
import Control.Memory.Region
import qualified Foreign.R as R
import Control.Monad.Primitive (unsafePrimToPrim)
import Control.Monad.R.Internal
import Data.Int (Int32)
import Data.Proxy (Proxy(..))
import Data.Reflection (Reifies(..))
import Data.Singletons (fromSing, sing)
import qualified Data.Vector.Generic.Mutable as G
import Data.Vector.SEXP.Base
import Foreign (Storable(..), Ptr, castPtr)
import Foreign.Marshal.Array (advancePtr, copyArray, moveArray)
import Foreign.R (SEXP)
import Foreign.R.Type (SSEXPTYPE)
import Internal.Error
data MVector s ty a = MVector
{ forall s (ty :: SEXPTYPE) a. MVector s ty a -> SEXP s ty
mvectorBase :: {-# UNPACK #-} !(SEXP s ty)
, forall s (ty :: SEXPTYPE) a. MVector s ty a -> Int32
mvectorOffset :: {-# UNPACK #-} !Int32
, forall s (ty :: SEXPTYPE) a. MVector s ty a -> Int32
mvectorLength :: {-# UNPACK #-} !Int32
}
newtype W t ty s a = W { forall t (ty :: SEXPTYPE) s a. W t ty s a -> MVector s ty a
unW :: MVector s ty a }
instance (Reifies t (AcquireIO s), VECTOR s ty a) => G.MVector (W t ty) a where
#if MIN_VERSION_vector(0,11,0)
basicInitialize :: forall (m :: * -> *). PrimMonad m => W t ty (PrimState m) a -> m ()
basicInitialize W t ty (PrimState m) a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif
{-# INLINE basicLength #-}
basicLength :: forall s. W t ty s a -> Int
basicLength (forall t (ty :: SEXPTYPE) s a. W t ty s a -> MVector s ty a
unW -> MVector SEXP s ty
_ Int32
_ Int32
len) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len
{-# INLINE basicUnsafeSlice #-}
basicUnsafeSlice :: forall s. Int -> Int -> W t ty s a -> W t ty s a
basicUnsafeSlice Int
j Int
m (forall t (ty :: SEXPTYPE) s a. W t ty s a -> MVector s ty a
unW -> MVector SEXP s ty
ptr Int32
off Int32
_len) =
forall t (ty :: SEXPTYPE) s a. MVector s ty a -> W t ty s a
W forall a b. (a -> b) -> a -> b
$ forall s (ty :: SEXPTYPE) a.
SEXP s ty -> Int32 -> Int32 -> MVector s ty a
MVector SEXP s ty
ptr (Int32
off forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)
{-# INLINE basicOverlaps #-}
basicOverlaps :: forall s. W t ty s a -> W t ty s a -> Bool
basicOverlaps (forall t (ty :: SEXPTYPE) s a. W t ty s a -> MVector s ty a
unW -> MVector SEXP s ty
ptr1 Int32
off1 Int32
len1) (forall t (ty :: SEXPTYPE) s a. W t ty s a -> MVector s ty a
unW -> MVector SEXP s ty
ptr2 Int32
off2 Int32
len2) =
SEXP s ty
ptr1 forall a. Eq a => a -> a -> Bool
== SEXP s ty
ptr2 Bool -> Bool -> Bool
&& (Int32
off2 forall a. Ord a => a -> a -> Bool
< Int32
off1 forall a. Num a => a -> a -> a
+ Int32
len1 Bool -> Bool -> Bool
|| Int32
off1 forall a. Ord a => a -> a -> Bool
< Int32
off2 forall a. Num a => a -> a -> a
+ Int32
len2)
{-# INLINE basicUnsafeNew #-}
basicUnsafeNew :: forall (m :: * -> *).
PrimMonad m =>
Int -> m (W t ty (PrimState m) a)
basicUnsafeNew Int
n
| forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing (forall {k} (a :: k). SingI a => Sing a
sing :: SSEXPTYPE ty) forall a. Eq a => a -> a -> Bool
== SEXPTYPE
R.Char =
forall a. String -> String -> a
failure String
"Data.Vector.SEXP.Mutable.new"
String
"R character vectors are immutable and globally cached. Use 'mkChar' instead."
| Bool
otherwise = do
SEXP s ty
sx <- forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (forall (ty :: SEXPTYPE). SEXP V ty -> IO (SEXP s ty)
acquireIO forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (a :: SEXPTYPE).
IsVector a =>
SSEXPTYPE a -> Int -> IO (SEXP V a)
R.allocVector (forall {k} (a :: k). SingI a => Sing a
sing :: SSEXPTYPE ty) Int
n)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall t (ty :: SEXPTYPE) s a. MVector s ty a -> W t ty s a
W forall a b. (a -> b) -> a -> b
$ forall s (ty :: SEXPTYPE) a.
SEXP s ty -> Int32 -> Int32 -> MVector s ty a
MVector (forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
R.unsafeRelease SEXP s ty
sx) Int32
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
where
AcquireIO forall (ty :: SEXPTYPE). SEXP V ty -> IO (SEXP s ty)
acquireIO = forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
reflect (forall {k} (t :: k). Proxy t
Proxy :: Proxy t)
{-# INLINE basicUnsafeRead #-}
basicUnsafeRead :: forall (m :: * -> *).
PrimMonad m =>
W t ty (PrimState m) a -> Int -> m a
basicUnsafeRead (forall t (ty :: SEXPTYPE) s a. W t ty s a -> MVector s ty a
unW -> MVector (PrimState m) ty a
mv) Int
i =
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (forall a s (ty :: SEXPTYPE). Storable a => MVector s ty a -> Ptr a
unsafeToPtr MVector (PrimState m) ty a
mv) Int
i
{-# INLINE basicUnsafeWrite #-}
basicUnsafeWrite :: forall (m :: * -> *).
PrimMonad m =>
W t ty (PrimState m) a -> Int -> a -> m ()
basicUnsafeWrite (forall t (ty :: SEXPTYPE) s a. W t ty s a -> MVector s ty a
unW -> MVector (PrimState m) ty a
mv) Int
i a
x =
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (forall a s (ty :: SEXPTYPE). Storable a => MVector s ty a -> Ptr a
unsafeToPtr MVector (PrimState m) ty a
mv) Int
i a
x
{-# INLINE basicUnsafeCopy #-}
basicUnsafeCopy :: forall (m :: * -> *).
PrimMonad m =>
W t ty (PrimState m) a -> W t ty (PrimState m) a -> m ()
basicUnsafeCopy w1 :: W t ty (PrimState m) a
w1@(forall t (ty :: SEXPTYPE) s a. W t ty s a -> MVector s ty a
unW -> MVector (PrimState m) ty a
mv1) (forall t (ty :: SEXPTYPE) s a. W t ty s a -> MVector s ty a
unW -> MVector (PrimState m) ty a
mv2) = forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim forall a b. (a -> b) -> a -> b
$ do
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray (forall a s (ty :: SEXPTYPE). Storable a => MVector s ty a -> Ptr a
unsafeToPtr MVector (PrimState m) ty a
mv1)
(forall a s (ty :: SEXPTYPE). Storable a => MVector s ty a -> Ptr a
unsafeToPtr MVector (PrimState m) ty a
mv2)
(forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
G.basicLength W t ty (PrimState m) a
w1)
{-# INLINE basicUnsafeMove #-}
basicUnsafeMove :: forall (m :: * -> *).
PrimMonad m =>
W t ty (PrimState m) a -> W t ty (PrimState m) a -> m ()
basicUnsafeMove w1 :: W t ty (PrimState m) a
w1@(forall t (ty :: SEXPTYPE) s a. W t ty s a -> MVector s ty a
unW -> MVector (PrimState m) ty a
mv1) (forall t (ty :: SEXPTYPE) s a. W t ty s a -> MVector s ty a
unW -> MVector (PrimState m) ty a
mv2) = forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim forall a b. (a -> b) -> a -> b
$ do
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
moveArray (forall a s (ty :: SEXPTYPE). Storable a => MVector s ty a -> Ptr a
unsafeToPtr MVector (PrimState m) ty a
mv1)
(forall a s (ty :: SEXPTYPE). Storable a => MVector s ty a -> Ptr a
unsafeToPtr MVector (PrimState m) ty a
mv2)
(forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
G.basicLength W t ty (PrimState m) a
w1)
unsafeToPtr :: Storable a => MVector s ty a -> Ptr a
unsafeToPtr :: forall a s (ty :: SEXPTYPE). Storable a => MVector s ty a -> Ptr a
unsafeToPtr (MVector SEXP s ty
sx Int32
off Int32
_) =
forall a b. Ptr a -> Ptr b
castPtr (forall s (a :: SEXPTYPE). SEXP s a -> Ptr ()
R.unsafeSEXPToVectorPtr SEXP s ty
sx) forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
off
proxyW :: Monad m => m (W t ty s a) -> proxy t -> m (MVector s ty a)
proxyW :: forall (m :: * -> *) t (ty :: SEXPTYPE) s a (proxy :: * -> *).
Monad m =>
m (W t ty s a) -> proxy t -> m (MVector s ty a)
proxyW m (W t ty s a)
m proxy t
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t (ty :: SEXPTYPE) s a. W t ty s a -> MVector s ty a
unW m (W t ty s a)
m
withW :: proxy t -> MVector s ty a -> W t ty s a
withW :: forall (proxy :: * -> *) t s (ty :: SEXPTYPE) a.
proxy t -> MVector s ty a -> W t ty s a
withW proxy t
_ MVector s ty a
v = forall t (ty :: SEXPTYPE) s a. MVector s ty a -> W t ty s a
W MVector s ty a
v
release :: (s' <= s) => MVector s ty a -> MVector s' ty a
release :: forall s' s (ty :: SEXPTYPE) a.
(s' <= s) =>
MVector s ty a -> MVector s' ty a
release = forall s (ty :: SEXPTYPE) a s'. MVector s ty a -> MVector s' ty a
unsafeRelease
unsafeRelease :: MVector s ty a -> MVector s' ty a
unsafeRelease :: forall s (ty :: SEXPTYPE) a s'. MVector s ty a -> MVector s' ty a
unsafeRelease (MVector SEXP s ty
b Int32
o Int32
l) = forall s (ty :: SEXPTYPE) a.
SEXP s ty -> Int32 -> Int32 -> MVector s ty a
MVector (forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
R.unsafeRelease SEXP s ty
b) Int32
o Int32
l