module Data.Params.Vector.Unboxed
( Vector
, module Data.Params.Vector
)
where
import Control.Category
import Prelude hiding ((.),id)
import Control.Monad
import Control.Monad.Primitive
import Control.Monad.Random
import Control.DeepSeq
import Data.Primitive
import Data.Primitive.ByteArray
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Primitive.Mutable as VPM
import GHC.Base (Int (..))
import GHC.Int
import GHC.Prim
import GHC.TypeLits
import Data.Params
import Data.Params.Vector
import Data.Params.PseudoPrim
import Unsafe.Coerce
import Language.Haskell.TH.Syntax hiding (reify)
import Debug.Trace
data family Vector (len::Config Nat) elem
mkParams ''Vector
instance (Show elem, VG.Vector (Vector len) elem) => Show (Vector len elem) where
show v = "fromList "++show (VG.toList v)
instance (Eq elem, VG.Vector (Vector len) elem) => Eq (Vector len elem) where
a == b = (VG.toList a) == (VG.toList b)
instance (Ord elem, VG.Vector (Vector len) elem) => Ord (Vector len elem) where
compare a b = compare (VG.toList a) (VG.toList b)
data instance Vector (Static len) elem = Vector
!Int
!(PseudoPrimInfo elem)
!ByteArray
instance
( KnownNat len
, PseudoPrim elem
) => StaticToAutomatic
Param_len
(Vector (Static len) elem)
(Vector Automatic elem)
where
staticToAutomatic _ (Vector off ppi arr) = Vector_Automatic off len ppi arr
where
len = fromIntegral $ natVal (Proxy::Proxy len)
mkPseudoPrimInfoFromStatic _ (PseudoPrimInfo_VectorStatic ppi)
= PseudoPrimInfo_VectorAutomatic len (len*size) ppi
where
len = fromIntegral $ natVal (Proxy::Proxy len)
size = pp_sizeOf ppi
instance
( KnownNat len
, StaticToAutomatic p elem elem'
) => StaticToAutomatic
(Param_elem p)
(Vector (Static len) elem)
(Vector (Static len) elem')
where
staticToAutomatic _ (Vector off ppi arr) = Vector off ppi' arr
where
ppi' = mkPseudoPrimInfoFromStatic (TypeLens::TypeLens Base p) ppi
mkPseudoPrimInfoFromStatic _ (PseudoPrimInfo_VectorStatic ppi)
= PseudoPrimInfo_VectorStatic $ mkPseudoPrimInfoFromStatic (TypeLens :: TypeLens Base p) ppi
instance
( PseudoPrim elem
) => RunTimeToAutomatic
Param_len
(Vector RunTime elem)
(Vector Automatic elem)
where
runTimeToAutomatic lens p v = mkApWith1Param
(Proxy::Proxy (Vector RunTime elem))
(Proxy::Proxy (Vector Automatic elem))
lens
p
go
v
where
go v@(Vector_RunTime off ppi arr) = Vector_Automatic off len ppi arr
where
len = VG.length v
mkPseudoPrimInfoFromRuntime _ len (PseudoPrimInfo_VectorRunTime ppi)
= PseudoPrimInfo_VectorAutomatic len (len*pp_sizeOf ppi) ppi
instance
( RunTimeToAutomatic p elem elem'
, HasDictionary p
, ReifiableConstraint (ApplyConstraint_GetConstraint p)
) => RunTimeToAutomatic
(Param_elem p)
(Vector (Static len) elem)
(Vector (Static len) elem')
where
runTimeToAutomatic lens p v = mkApWith1Param
(Proxy::Proxy (Vector (Static len) elem))
(Proxy::Proxy (Vector (Static len) elem'))
lens
p
go
v
where
go :: Vector (Static len) elem -> Vector (Static len) elem'
go (Vector off ppi arr) = Vector off ppi' arr
where
ppi' = mkPseudoPrimInfoFromRuntime (TypeLens::TypeLens Base p) p ppi
:: PseudoPrimInfo elem'
mkPseudoPrimInfoFromRuntime _ p (PseudoPrimInfo_VectorStatic ppi)
= PseudoPrimInfo_VectorStatic $ mkPseudoPrimInfoFromRuntime (TypeLens::TypeLens Base p) p ppi
instance
( RunTimeToAutomatic p elem elem'
, HasDictionary p
, ReifiableConstraint (ApplyConstraint_GetConstraint p)
) => RunTimeToAutomatic
(Param_elem p)
(Vector RunTime elem)
(Vector RunTime elem')
where
runTimeToAutomatic lens p v = mkApWith1Param
(Proxy::Proxy (Vector RunTime elem))
(Proxy::Proxy (Vector RunTime elem'))
lens
p
go
v
where
go :: Vector RunTime elem -> Vector RunTime elem'
go (Vector_RunTime off ppi arr) = Vector_RunTime off ppi' arr
where
ppi' = mkPseudoPrimInfoFromRuntime (TypeLens::TypeLens Base p) p ppi
:: PseudoPrimInfo elem'
mkPseudoPrimInfoFromRuntime _ p (PseudoPrimInfo_VectorRunTime ppi)
= PseudoPrimInfo_VectorRunTime $ mkPseudoPrimInfoFromRuntime (TypeLens::TypeLens Base p) p ppi
instance
( RunTimeToAutomatic p elem elem'
, HasDictionary p
, ReifiableConstraint (ApplyConstraint_GetConstraint p)
) => RunTimeToAutomatic
(Param_elem p)
(Vector Automatic elem)
(Vector Automatic elem')
where
runTimeToAutomatic lens p v = mkApWith1Param
(Proxy::Proxy (Vector Automatic elem))
(Proxy::Proxy (Vector Automatic elem'))
lens
p
go
v
where
go :: Vector Automatic elem -> Vector Automatic elem'
go (Vector_Automatic len off ppi arr) = Vector_Automatic len off ppi' arr
where
ppi' = mkPseudoPrimInfoFromRuntime (TypeLens::TypeLens Base p) p ppi
:: PseudoPrimInfo elem'
mkPseudoPrimInfoFromRuntime _ p (PseudoPrimInfo_VectorAutomatic len size ppi)
= PseudoPrimInfo_VectorAutomatic
len
size
(mkPseudoPrimInfoFromRuntime (TypeLens::TypeLens Base p) p ppi)
instance NFData (Vector (Static len) elem) where
rnf a = seq a ()
instance
( PseudoPrim elem
, KnownNat len
) => VG.Vector (Vector (Static len)) elem
where
basicUnsafeFreeze (MVector i ppi marr) = Vector i ppi `liftM` unsafeFreezeByteArray marr
basicUnsafeThaw (Vector i ppi arr) = MVector i ppi `liftM` unsafeThawByteArray arr
basicLength _ = viewParam _len (undefined::Vector (Static len) elem)
basicUnsafeSlice j n v = if n /= viewParam _len (undefined::Vector (Static len) elem) || j /= 0
then error $ "Vector.basicUnsafeSlice not allowed to change size"
else v
basicUnsafeIndexM (Vector i ppi arr) j = return $! pp_indexByteArray ppi arr (i+j)
elemseq _ = seq
unInt :: Int -> Int#
unInt (I# i) = i
instance
( Prim elem
, PseudoPrim elem
, KnownNat len
) => Prim (Vector (Static len) elem)
where
sizeOf# _ =
unInt (sizeOf (undefined::elem)* (intparam (Proxy::Proxy len)))
alignment# _ =
unInt (alignment (undefined :: elem))
indexByteArray# arr# i# =
Vector ((I# i#)*(intparam (Proxy::Proxy len))) (emptyInfo::PseudoPrimInfo elem) (ByteArray arr#)
readByteArray# marr# i# s# =
(# s#, Vector (I# i#) (emptyInfo::PseudoPrimInfo elem) (ByteArray (unsafeCoerce# marr#)) #)
writeByteArray# marr# i# x s# = go 0 s#
where
go i s = ( if i >= intparam (Proxy::Proxy len)
then s
else go (i+1)
(writeByteArray# marr#
(i# *# (unInt ( intparam (Proxy::Proxy len))) +# (unInt i))
(x `VG.unsafeIndex` i)
s
)
)
where
iii = I# (i# *# (sizeOf# (undefined::elem)) +# (unInt i))
instance
( PseudoPrim elem
, KnownNat len
, Show elem
) => PseudoPrim (Vector (Static len) elem)
where
newtype PseudoPrimInfo (Vector (Static len) elem) =
PseudoPrimInfo_VectorStatic (PseudoPrimInfo elem)
pp_sizeOf# (PseudoPrimInfo_VectorStatic ppi) =
unInt (pp_sizeOf ppi * (intparam (Proxy::Proxy len)))
pp_alignment# (PseudoPrimInfo_VectorStatic ppi) =
unInt (pp_alignment ppi)
pp_indexByteArray# (PseudoPrimInfo_VectorStatic ppi) arr# i# =
Vector ((I# i#)*(intparam (Proxy::Proxy len))) ppi (ByteArray arr#)
pp_readByteArray# (PseudoPrimInfo_VectorStatic ppi) marr# i# s# =
(# s#, Vector (I# i#) ppi (ByteArray (unsafeCoerce# marr#)) #)
pp_writeByteArray# (PseudoPrimInfo_VectorStatic ppi) marr# i# x s# = go 0 s#
where
go i s = ( if i >= intparam (Proxy::Proxy len)
then s
else go (i+1)
(pp_writeByteArray# ppi marr#
(i# *# (unInt ( intparam (Proxy::Proxy len))) +# (unInt i))
(x `VG.unsafeIndex` i)
s
)
)
where
iii = I# (i# *# (pp_sizeOf# ppi) +# (unInt i))
seqInfo _ = seqInfo (undefined::elem)
emptyInfo = PseudoPrimInfo_VectorStatic emptyInfo
data instance Vector RunTime elem = Vector_RunTime
!Int
!(PseudoPrimInfo elem)
!ByteArray
instance NFData (Vector RunTime elem) where
rnf a = seq a ()
instance
( PseudoPrim elem
, ViewParam Param_len (Vector RunTime elem)
) => VG.Vector (Vector RunTime) elem
where
basicUnsafeFreeze (MVector_RunTime len i ppi marr) =
if len == viewParam _len (undefined::Vector RunTime elem)
then Vector_RunTime i ppi `liftM` unsafeFreezeByteArray marr
else error $ "basicUnsafeFreeze cannot change RunTime vector size"
++ "; len="++show len
++ "; getParam_len="++show (viewParam _len (undefined::Vector RunTime elem))
basicUnsafeThaw (Vector_RunTime i ppi arr) =
MVector_RunTime (viewParam _len (undefined::Vector RunTime elem)) i ppi `liftM` unsafeThawByteArray arr
basicLength _ = viewParam _len (undefined::Vector RunTime elem)
basicUnsafeSlice j n v =
if n /= viewParam _len (undefined::Vector RunTime elem) || j /= 0
then error $ "Vector_RunTime.basicUnsafeSlice not allowed to change size"
else v
basicUnsafeIndexM (Vector_RunTime i ppi arr) j = return $! pp_indexByteArray ppi arr (i+j)
elemseq _ = seq
instance
( PseudoPrim elem
, ViewParam Param_len (Vector RunTime elem)
) => PseudoPrim (Vector RunTime elem)
where
newtype PseudoPrimInfo (Vector RunTime elem) =
PseudoPrimInfo_VectorRunTime (PseudoPrimInfo elem)
pp_sizeOf# (PseudoPrimInfo_VectorRunTime ppi) =
unInt (pp_sizeOf ppi * (viewParam _len (undefined::Vector RunTime elem)))
pp_alignment# (PseudoPrimInfo_VectorRunTime ppi) =
unInt (pp_alignment ppi)
pp_indexByteArray# (PseudoPrimInfo_VectorRunTime ppi)arr# i# =
Vector_RunTime ((I# i#)*(viewParam _len (undefined::Vector RunTime elem))) ppi (ByteArray arr#)
pp_readByteArray# (PseudoPrimInfo_VectorRunTime ppi) marr# i# s# =
(# s#, Vector_RunTime (I# i#) ppi (ByteArray (unsafeCoerce# marr#)) #)
pp_writeByteArray# (PseudoPrimInfo_VectorRunTime ppi) marr# i# x s# = go 0 s#
where
go i s = ( if i >= len
then s
else go (i+1)
(pp_writeByteArray# ppi marr#
(i# *# (unInt len) +# (unInt i))
(x VG.! i)
s
)
)
where
len = viewParam _len (undefined::Vector RunTime elem)
iii = I# (i# *# (pp_sizeOf# ppi) +# (unInt i))
seqInfo _ = seqInfo (undefined::elem)
emptyInfo = PseudoPrimInfo_VectorRunTime emptyInfo
data instance Vector Automatic elem = Vector_Automatic
!Int
!Int
!(PseudoPrimInfo elem)
!ByteArray
instance NFData (Vector Automatic elem) where
rnf v = seq v ()
instance PseudoPrim elem => VG.Vector (Vector Automatic) elem where
basicUnsafeFreeze (MVector_Automatic i n ppi marr)
= Vector_Automatic i n ppi `liftM` unsafeFreezeByteArray marr
basicUnsafeThaw (Vector_Automatic i n ppi arr)
= MVector_Automatic i n ppi `liftM` unsafeThawByteArray arr
basicLength (Vector_Automatic _ n _ _) = n
basicUnsafeSlice j n (Vector_Automatic i _ ppi arr) = Vector_Automatic (i+j) n ppi arr
basicUnsafeIndexM (Vector_Automatic i _ ppi arr) j = return $! pp_indexByteArray ppi arr (i+j)
elemseq _ = seq
instance PseudoPrim elem => PseudoPrim (Vector Automatic elem) where
data PseudoPrimInfo (Vector Automatic elem) = PseudoPrimInfo_VectorAutomatic
!(Int)
!(Int)
!(PseudoPrimInfo elem)
pp_sizeOf# (PseudoPrimInfo_VectorAutomatic _ s _) = unInt s
pp_alignment# (PseudoPrimInfo_VectorAutomatic _ _ ppi) =
unInt (pp_alignment ppi)
pp_indexByteArray# (PseudoPrimInfo_VectorAutomatic len _ ppi) arr# i# =
Vector_Automatic ((I# i#)*len) len ppi (ByteArray arr#)
pp_readByteArray# (PseudoPrimInfo_VectorAutomatic len _ ppi) marr# i# s# =
(# s#, Vector_Automatic (I# i#) len ppi (ByteArray (unsafeCoerce# marr#)) #)
pp_writeByteArray# (PseudoPrimInfo_VectorAutomatic len _ ppi) marr# i# x s# = go 0 s#
where
go i s = ( if i >= len
then s
else go (i+1)
(pp_writeByteArray# ppi marr#
(i# *# (unInt len) +# (unInt i))
(x VG.! i)
s
)
)
where
iii = I# (i# *# (pp_sizeOf# ppi) +# (unInt i))
seqInfo _ = False
emptyInfo = error "emptyInfo of PseudoPrimInfo_VectorAutomatic"
data family MVector (len::Config Nat) s elem
type instance VG.Mutable (Vector len) = MVector len
data instance MVector (Static len) s elem = MVector
!Int
!(PseudoPrimInfo elem)
!(MutableByteArray s)
instance
( PseudoPrim elem
, KnownNat len
) => VGM.MVector (MVector (Static len)) elem
where
basicLength _ = fromIntegral $ natVal (Proxy::Proxy len)
basicUnsafeSlice i m v = if m /= len
then error $ "MVector (Static len) .basicUnsafeSlice not allowed to change size"
++"; i="++show i
++"; m="++show m
++"; len="++show len
else v
where
len = intparam (Proxy::Proxy len)
basicOverlaps (MVector i ppi1 arr1) (MVector j ppi2 arr2)
= sameMutableByteArray arr1 arr2
&& (between i j (j+len) || between j i (i+len))
where
len = intparam (Proxy::Proxy len)
between x y z = x >= y && x < z
basicUnsafeNew n = if seqInfo (undefined::elem)
then error "basicUnsafeNew: seqInfo"
else do
arr <- newPinnedByteArray (len * pp_sizeOf (emptyInfo :: PseudoPrimInfo elem))
return $ MVector 0 (emptyInfo::PseudoPrimInfo elem) arr
where
len = intparam (Proxy::Proxy len)
basicUnsafeRead (MVector i ppi arr) j = pp_readByteArray ppi arr (i+j)
basicUnsafeWrite (MVector i ppi arr) j x = pp_writeByteArray ppi arr (i+j) x
data instance MVector RunTime s elem = MVector_RunTime
!Int
!Int
!(PseudoPrimInfo elem)
!(MutableByteArray s)
instance
( PseudoPrim elem
) => VGM.MVector (MVector RunTime) elem
where
basicLength (MVector_RunTime n _ ppi _) = n
basicUnsafeSlice i m (MVector_RunTime n j ppi v) = MVector_RunTime m (i+j) ppi v
basicOverlaps (MVector_RunTime m i ppi1 arr1) (MVector_RunTime n j ppi2 arr2)
= sameMutableByteArray arr1 arr2
&& (between i j (j+m) || between j i (i+n))
where
between x y z = x >= y && x < z
basicUnsafeNew n = if seqInfo (undefined::elem)
then error "basicUnsafeNew: seqInfo"
else do
arr <- newPinnedByteArray (n * pp_sizeOf (emptyInfo :: PseudoPrimInfo elem))
return $ MVector_RunTime n 0 emptyInfo arr
basicUnsafeRead (MVector_RunTime _ i ppi arr) j = pp_readByteArray ppi arr (i+j)
basicUnsafeWrite (MVector_RunTime _ i ppi arr) j x = pp_writeByteArray ppi arr (i+j) x
data instance MVector Automatic s elem = MVector_Automatic
!Int
!Int
!(PseudoPrimInfo elem)
!(MutableByteArray s)
instance
( PseudoPrim elem
) => VGM.MVector (MVector Automatic) elem
where
basicLength (MVector_Automatic _ n ppi _) = n
basicUnsafeSlice i m (MVector_Automatic j n ppi v) = MVector_Automatic (i+j) m ppi v
basicOverlaps (MVector_Automatic i m ppi1 arr1) (MVector_Automatic j n ppi2 arr2)
= sameMutableByteArray arr1 arr2
&& (between i j (j+m) || between j i (i+n))
where
between x y z = x >= y && x < z
basicUnsafeNew n = if seqInfo (undefined::elem)
then error "basicUnsafeNew: seqInfo"
else do
arr <- newPinnedByteArray (n * pp_sizeOf (emptyInfo :: PseudoPrimInfo elem))
return $ MVector_Automatic 0 n emptyInfo arr
basicUnsafeRead (MVector_Automatic i _ ppi arr) j = pp_readByteArray ppi arr (i+j)
basicUnsafeWrite (MVector_Automatic i _ ppi arr) j x = pp_writeByteArray ppi arr (i+j) x