Move both mutable and immutable vectors to Unsafe module

Author: Shimuuar

vector/src/Data/Vector/Primitive.hs

@@ -158,150 +158,17 @@ module Data.Vector.Primitive (
 ) where
 
 import qualified Data.Vector.Generic           as G
-import           Data.Vector.Primitive.Mutable ( MVector(..) )
+import           Data.Vector.Primitive.Unsafe  (Vector(..),MVector(..),unsafeCoerceVector)
 import           Data.Vector.Internal.Check
-import qualified Data.Vector.Fusion.Bundle as Bundle
-import           Data.Primitive.ByteArray
 import           Data.Primitive ( Prim, sizeOf )
 
-import Control.DeepSeq ( NFData(rnf)
-#if MIN_VERSION_deepseq(1,4,3)
-                       , NFData1(liftRnf)
-#endif
-                       )
-
-import Control.Monad ( liftM )
 import Control.Monad.ST ( ST )
 import Control.Monad.Primitive
 
 import Prelude
-  ( Eq, Ord, Num, Enum, Monoid, Traversable, Monad, Read, Show, Bool, Ordering(..), Int, Maybe, Either
-  , compare, mempty, mappend, mconcat, showsPrec, return, otherwise, seq, error, undefined
-  , (+), (*), (<), (<=), (>), (>=), (==), (/=), ($!) )
-
-import Data.Data      ( Data(..) )
-import Text.Read      ( Read(..), readListPrecDefault )
-import Data.Semigroup ( Semigroup(..) )
-
-import Data.Coerce
-import Unsafe.Coerce
-import qualified GHC.Exts as Exts
-
-type role Vector nominal
-
--- | /O(1)/ Unsafely coerce an immutable vector from one element type to another,
--- representationally equal type. The operation just changes the type of the
--- underlying pointer and does not modify the elements.
---
--- This is marginally safer than 'unsafeCast', since this function imposes an
--- extra 'Coercible' constraint. The constraint guarantees that the element types
--- are representationally equal. It however cannot guarantee
--- that their respective 'Prim' instances are compatible.
-unsafeCoerceVector :: Coercible a b => Vector a -> Vector b
-unsafeCoerceVector = unsafeCoerce
-
--- | Unboxed vectors of primitive types.
-data Vector a = Vector {-# UNPACK #-} !Int       -- ^ offset
-                       {-# UNPACK #-} !Int       -- ^ length
-                       {-# UNPACK #-} !ByteArray -- ^ underlying byte array
-
-instance NFData (Vector a) where
-  rnf (Vector _ _ _) = ()
-
-#if MIN_VERSION_deepseq(1,4,3)
--- | @since 0.12.1.0
-instance NFData1 Vector where
-  liftRnf _ (Vector _ _ _) = ()
-#endif
-
-instance (Show a, Prim a) => Show (Vector a) where
-  showsPrec = G.showsPrec
-
-instance (Read a, Prim a) => Read (Vector a) where
-  readPrec = G.readPrec
-  readListPrec = readListPrecDefault
-
-instance (Data a, Prim a) => Data (Vector a) where
-  gfoldl       = G.gfoldl
-  toConstr _   = G.mkVecConstr "Data.Vector.Primitive.Vector"
-  gunfold      = G.gunfold
-  dataTypeOf _ = G.mkVecType "Data.Vector.Primitive.Vector"
-  dataCast1    = G.dataCast
-
-
-type instance G.Mutable Vector = MVector
-
-instance Prim a => G.Vector Vector a where
-  {-# INLINE basicUnsafeFreeze #-}
-  basicUnsafeFreeze (MVector i n marr)
-    = Vector i n `liftM` unsafeFreezeByteArray marr
-
-  {-# INLINE basicUnsafeThaw #-}
-  basicUnsafeThaw (Vector i n arr)
-    = MVector i n `liftM` unsafeThawByteArray arr
-
-  {-# INLINE basicLength #-}
-  basicLength (Vector _ n _) = n
-
-  {-# INLINE basicUnsafeSlice #-}
-  basicUnsafeSlice j n (Vector i _ arr) = Vector (i+j) n arr
-
-  {-# INLINE basicUnsafeIndexM #-}
-  basicUnsafeIndexM (Vector i _ arr) j = return $! indexByteArray arr (i+j)
-
-  {-# INLINE basicUnsafeCopy #-}
-  basicUnsafeCopy (MVector i n dst) (Vector j _ src)
-    = copyByteArray dst (i*sz) src (j*sz) (n*sz)
-    where
-      sz = sizeOf (undefined :: a)
-
-  {-# INLINE elemseq #-}
-  elemseq _ = seq
-
--- See http://trac.haskell.org/vector/ticket/12
-instance (Prim a, Eq a) => Eq (Vector a) where
-  {-# INLINE (==) #-}
-  xs == ys = Bundle.eq (G.stream xs) (G.stream ys)
-
--- See http://trac.haskell.org/vector/ticket/12
-instance (Prim a, Ord a) => Ord (Vector a) where
-  {-# INLINE compare #-}
-  compare xs ys = Bundle.cmp (G.stream xs) (G.stream ys)
-
-  {-# INLINE (<) #-}
-  xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT
-
-  {-# INLINE (<=) #-}
-  xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT
-
-  {-# INLINE (>) #-}
-  xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT
-
-  {-# INLINE (>=) #-}
-  xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT
-
-instance Prim a => Semigroup (Vector a) where
-  {-# INLINE (<>) #-}
-  (<>) = (++)
-
-  {-# INLINE sconcat #-}
-  sconcat = G.concatNE
-
-instance Prim a => Monoid (Vector a) where
-  {-# INLINE mempty #-}
-  mempty = empty
-
-  {-# INLINE mappend #-}
-  mappend = (<>)
-
-  {-# INLINE mconcat #-}
-  mconcat = concat
-
-instance Prim a => Exts.IsList (Vector a) where
-  type Item (Vector a) = a
-  fromList = fromList
-  fromListN = fromListN
-  toList = toList
+  ( Eq, Ord, Num, Enum, Monoid, Traversable, Monad, Bool, Ordering(..), Int, Maybe, Either
+  , otherwise, error, undefined
+  , (==))
 
 
 -- Length
@@ -1952,4 +1819,4 @@ copy :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m ()
 copy = G.copy
 
 -- $setup
--- >>> import Prelude (($), min, even, max, succ, id, Ord(..))
+-- >>> import Prelude (($), min, even, max, succ, id, Ord(..), Num(..))

vector/src/Data/Vector/Primitive/Mutable.hs

@@ -69,107 +69,23 @@ module Data.Vector.Primitive.Mutable (
 ) where
 
 import qualified Data.Vector.Generic.Mutable as G
-import           Data.Primitive.ByteArray
 import           Data.Primitive ( Prim, sizeOf )
 import           Data.Vector.Internal.Check
-import           Data.Word ( Word8 )
+import           Data.Vector.Primitive.Unsafe (MVector,IOVector,STVector,unsafeCoerceMVector,unsafeCast)
+import qualified Data.Vector.Primitive.Unsafe as U
 import           Control.Monad.Primitive
-import           Control.Monad ( liftM )
 
-import Control.DeepSeq ( NFData(rnf)
-#if MIN_VERSION_deepseq(1,4,3)
-                       , NFData1(liftRnf)
-#endif
-                       )
 
 import Prelude
   ( Ord, Bool, Int, Maybe, Ordering(..)
-  , otherwise, error, undefined, div, show, maxBound
-  , (+), (*), (<), (>), (>=), (==), (&&), (||), ($), (++) )
+  , otherwise, error, undefined
+  , (==))
 
-import Data.Coerce
-import Unsafe.Coerce
 
 -- Data.Vector.Internal.Check is unnecessary
 #define NOT_VECTOR_MODULE
 #include "vector.h"
 
-type role MVector nominal nominal
-
--- | /O(1)/ Unsafely coerce a mutable vector from one element type to another,
--- representationally equal type. The operation just changes the type of the
--- underlying pointer and does not modify the elements.
---
--- Note that this function is unsafe. The @Coercible@ constraint guarantees
--- that the element types are representationally equal. It however cannot
--- guarantee that their respective 'Prim' instances are compatible.
-unsafeCoerceMVector :: Coercible a b => MVector s a -> MVector s b
-unsafeCoerceMVector = unsafeCoerce
-
--- | Mutable vectors of primitive types.
-data MVector s a = MVector {-# UNPACK #-} !Int                  -- ^ offset
-                           {-# UNPACK #-} !Int                  -- ^ length
-                           {-# UNPACK #-} !(MutableByteArray s) -- ^ underlying mutable byte array
-
-type IOVector = MVector RealWorld
-type STVector s = MVector s
-
-instance NFData (MVector s a) where
-  rnf (MVector _ _ _) = ()
-
-#if MIN_VERSION_deepseq(1,4,3)
-instance NFData1 (MVector s) where
-  liftRnf _ (MVector _ _ _) = ()
-#endif
-
-instance Prim a => G.MVector MVector a where
-  basicLength (MVector _ n _) = n
-  basicUnsafeSlice j m (MVector i _ arr)
-    = MVector (i+j) m arr
-
-  {-# INLINE basicOverlaps #-}
-  basicOverlaps (MVector i m arr1) (MVector j n arr2)
-    = sameMutableByteArray arr1 arr2
-      && (between i j (j+n) || between j i (i+m))
-    where
-      between x y z = x >= y && x < z
-
-  {-# INLINE basicUnsafeNew #-}
-  basicUnsafeNew n
-    | n < 0 = error $ "Primitive.basicUnsafeNew: negative length: " ++ show n
-    | n > mx = error $ "Primitive.basicUnsafeNew: length too large: " ++ show n
-    | otherwise = MVector 0 n `liftM` newByteArray (n * size)
-    where
-      size = sizeOf (undefined :: a)
-      mx = maxBound `div` size :: Int
-
-  {-# INLINE basicInitialize #-}
-  basicInitialize (MVector off n v) =
-      setByteArray v (off * size) (n * size) (0 :: Word8)
-    where
-      size = sizeOf (undefined :: a)
-
-
-  {-# INLINE basicUnsafeRead #-}
-  basicUnsafeRead (MVector i _ arr) j = readByteArray arr (i+j)
-
-  {-# INLINE basicUnsafeWrite #-}
-  basicUnsafeWrite (MVector i _ arr) j x = writeByteArray arr (i+j) x
-
-  {-# INLINE basicUnsafeCopy #-}
-  basicUnsafeCopy (MVector i n dst) (MVector j _ src)
-    = copyMutableByteArray dst (i*sz) src (j*sz) (n*sz)
-    where
-      sz = sizeOf (undefined :: a)
-
-  {-# INLINE basicUnsafeMove #-}
-  basicUnsafeMove (MVector i n dst) (MVector j _ src)
-    = moveByteArray dst (i*sz) src (j*sz) (n * sz)
-    where
-      sz = sizeOf (undefined :: a)
-
-  {-# INLINE basicSet #-}
-  basicSet (MVector i n arr) x = setByteArray arr i n x
 
 -- Length information
 -- ------------------
@@ -724,18 +640,5 @@ ifoldrM' :: (PrimMonad m, Prim a) => (Int -> a -> b -> m b) -> b -> MVector (Pri
 {-# INLINE ifoldrM' #-}
 ifoldrM' = G.ifoldrM'
 
--- Unsafe conversions
--- ------------------
-
--- | /O(1)/ Unsafely cast a vector from one element type to another.
--- This operation just changes the type of the vector and does not
--- modify the elements.
---
--- This function will throw an error if elements are of mismatching sizes.
---
--- | @since 0.13.0.0
-unsafeCast :: forall a b s. (HasCallStack, Prim a, Prim b) => MVector s a -> MVector s b
-{-# INLINE unsafeCast #-}
-unsafeCast (MVector o n ba)
-  | sizeOf (undefined :: a) == sizeOf (undefined :: b) = MVector o n ba
-  | otherwise = error "Element size mismatch"
+-- $setup
+-- >>> import Prelude (($), Num(..))