{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Data.Massiv.Array.Manifest.Vector
( fromVectorM
, fromVector'
, castFromVector
, toVector
, castToVector
, ARepr
, VRepr
) where
import Control.Monad (guard, join, msum)
import Data.Massiv.Array.Manifest.Boxed
import Data.Massiv.Array.Manifest.Internal
import Data.Massiv.Array.Manifest.Primitive
import Data.Massiv.Array.Manifest.Storable
import Data.Massiv.Array.Manifest.Unboxed
import Data.Massiv.Array.Mutable
import Data.Massiv.Core.Common
import Data.Maybe (fromMaybe)
import Data.Typeable
import qualified Data.Vector as VB
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Unboxed as VU
type family ARepr (v :: * -> *) :: * where
ARepr VU.Vector = U
ARepr VS.Vector = S
ARepr VP.Vector = P
ARepr VB.Vector = B
type family VRepr r :: * -> * where
VRepr U = VU.Vector
VRepr S = VS.Vector
VRepr P = VP.Vector
VRepr B = VB.Vector
VRepr N = VB.Vector
castFromVector :: forall v r ix e. (VG.Vector v e, Typeable v, Mutable r ix e, ARepr v ~ r)
=> Comp
-> Sz ix
-> v e
-> Maybe (Array r ix e)
castFromVector comp sz vector = do
guard (totalElem sz == VG.length vector)
msum
[ do Refl <- eqT :: Maybe (v :~: VU.Vector)
uVector <- join $ gcast1 (Just vector)
return $ UArray {uComp = comp, uSize = sz, uData = uVector}
, do Refl <- eqT :: Maybe (v :~: VS.Vector)
sVector <- join $ gcast1 (Just vector)
return $ SArray {sComp = comp, sSize = sz, sData = sVector}
, do Refl <- eqT :: Maybe (v :~: VP.Vector)
VP.Vector 0 _ arr <- join $ gcast1 (Just vector)
return $ PArray {pComp = comp, pSize = sz, pData = arr}
, do Refl <- eqT :: Maybe (v :~: VB.Vector)
bVector <- join $ gcast1 (Just vector)
arr <- castVectorToArray bVector
let barr = BArray {bComp = comp, bSize = sz, bData = arr}
barr `seqArray` return barr
]
{-# NOINLINE castFromVector #-}
fromVectorM ::
( MonadThrow m
, Typeable v
, VG.Vector v a
, Mutable (ARepr v) ix a
, Mutable r ix a
)
=> Comp
-> Sz ix
-> v a
-> m (Array r ix a)
fromVectorM comp sz v =
case castFromVector comp sz v of
Just arr -> pure $ convert arr
Nothing -> do
guardNumberOfElements sz (Sz (VG.length v))
pure (makeArrayLinear comp sz (VG.unsafeIndex v))
{-# NOINLINE fromVectorM #-}
fromVector' ::
(Typeable v, VG.Vector v a, Mutable (ARepr v) ix a, Mutable r ix a)
=> Comp
-> Sz ix
-> v a
-> Array r ix a
fromVector' comp sz = either throw id . fromVectorM comp sz
{-# INLINE fromVector' #-}
castToVector :: forall v r ix e . (Mutable r ix e, VRepr r ~ v)
=> Array r ix e -> Maybe (v e)
castToVector arr =
msum
[ do Refl <- eqT :: Maybe (r :~: U)
uArr <- gcastArr arr
return $ uData uArr
, do Refl <- eqT :: Maybe (r :~: S)
sArr <- gcastArr arr
return $ sData sArr
, do Refl <- eqT :: Maybe (r :~: P)
pArr <- gcastArr arr
return $ VP.Vector 0 (totalElem (size arr)) $ pData pArr
, do Refl <- eqT :: Maybe (r :~: B)
bArr <- gcastArr arr
return $ castArrayToVector $ bData bArr
, do Refl <- eqT :: Maybe (r :~: N)
bArr <- gcastArr arr
return $ castArrayToVector $ bData $ bArray bArr
]
{-# NOINLINE castToVector #-}
toVector ::
forall r ix e v.
( Manifest r ix e
, Mutable (ARepr v) ix e
, VG.Vector v e
, VRepr (ARepr v) ~ v
)
=> Array r ix e
-> v e
toVector arr =
fromMaybe
(VG.generate (totalElem (size arr)) (unsafeLinearIndex arr))
(castToVector (convert arr :: Array (ARepr v) ix e))
{-# NOINLINE toVector #-}