Strict boxed: Add Unsafe modules

Author: Shimuuar

vector/src/Data/Vector/Strict.hs

@@ -178,220 +178,17 @@ module Data.Vector.Strict (
 ) where
 
 import Control.Applicative (Applicative)
-import Data.Coerce
-import Data.Vector.Strict.Mutable  ( MVector(..) )
-import Data.Primitive.Array
+import Control.Monad.Primitive
+import Data.Vector.Strict.Mutable.Unsafe  ( MVector(..) )
+import Data.Vector.Strict.Unsafe
 import qualified Data.Vector.Generic as G
-import qualified Data.Vector as V
-
-import Control.DeepSeq ( NFData(rnf), NFData1(liftRnf))
+import qualified Data.Traversable as Traversable
 
-import Control.Monad ( MonadPlus(..), ap )
-import Control.Monad.ST ( ST, runST )
-import Control.Monad.Primitive
-import qualified Control.Monad.Fail as Fail
-import Control.Monad.Fix ( MonadFix (mfix) )
-import Control.Monad.Zip
-import Data.Function ( fix )
+import Control.Monad.ST ( ST )
 
 import Prelude
-  ( Eq(..), Ord(..), Num, Enum, Monoid, Functor, Monad, Show, Bool, Ordering(..), Int, Maybe, Either
-  , return, showsPrec, fmap, otherwise, id, flip, const
-  , (>>=), (+), (-), (.), ($), seq)
-
-import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..))
-import Data.Data      ( Data(..) )
-import Text.Read      ( Read(..), readListPrecDefault )
-import Data.Semigroup ( Semigroup(..) )
-
-import qualified Control.Applicative as Applicative
-import qualified Data.Foldable as Foldable
-import qualified Data.Traversable as Traversable
-
-import qualified GHC.Exts as Exts (IsList(..))
-
-
--- | Strict boxed vectors, supporting efficient slicing.
-newtype Vector a = Vector (V.Vector a)
-  deriving (Foldable.Foldable, Semigroup, Monoid)
-
--- NOTE: [GND for strict vector]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
---
--- Strict boxed vectors (both mutable an immutable) are newtypes over
--- lazy ones. This makes it possible to use GND to derive instances.
--- However one must take care to preserve strictness since Vector
--- instance for lazy vectors would be used.
---
--- In general it's OK to derive instances where vectors are passed as
--- parameters (e.g. Eq, Ord) and not OK to derive ones where new
--- vector is created (e.g. Read, Functor)
-
-instance NFData a => NFData (Vector a) where
-  rnf = liftRnf rnf
-  {-# INLINEABLE rnf #-}
-
--- | @since 0.13.2.0
-instance NFData1 Vector where
-  liftRnf elemRnf = foldl' (\_ -> elemRnf) ()
-  {-# INLINEABLE liftRnf #-}
-
-instance Show a => Show (Vector a) where
-  showsPrec = G.showsPrec
-
-instance Read a => Read (Vector a) where
-  readPrec = G.readPrec
-  readListPrec = readListPrecDefault
-
-instance Show1 Vector where
-  liftShowsPrec = G.liftShowsPrec
-
-instance Read1 Vector where
-  liftReadsPrec = G.liftReadsPrec
-
-instance Exts.IsList (Vector a) where
-  type Item (Vector a) = a
-  fromList = Data.Vector.Strict.fromList
-  fromListN = Data.Vector.Strict.fromListN
-  toList = toList
-
-instance Data a => Data (Vector a) where
-  gfoldl       = G.gfoldl
-  toConstr _   = G.mkVecConstr "Data.Vector.Strict.Vector"
-  gunfold      = G.gunfold
-  dataTypeOf _ = G.mkVecType "Data.Vector.Strict.Vector"
-  dataCast1    = G.dataCast
-
-type instance G.Mutable Vector = MVector
-
-instance G.Vector Vector a where
-  {-# INLINE basicUnsafeFreeze #-}
-  basicUnsafeFreeze = coerce (G.basicUnsafeFreeze @V.Vector @a)
-  {-# INLINE basicUnsafeThaw #-}
-  basicUnsafeThaw = coerce (G.basicUnsafeThaw @V.Vector @a)
-  {-# INLINE basicLength #-}
-  basicLength = coerce (G.basicLength @V.Vector @a)
-  {-# INLINE basicUnsafeSlice #-}
-  basicUnsafeSlice = coerce (G.basicUnsafeSlice @V.Vector @a)
-  {-# INLINE basicUnsafeIndexM #-}
-  basicUnsafeIndexM = coerce (G.basicUnsafeIndexM @V.Vector @a)
-  {-# INLINE basicUnsafeCopy #-}
-  basicUnsafeCopy = coerce (G.basicUnsafeCopy @V.Vector @a)
-  {-# INLINE elemseq #-}
-  elemseq _ = seq
-
--- See NOTE: [GND for strict vector]
---
--- Deriving strategies are only available since 8.2. So we can't use
--- deriving newtype until we drop support for 8.0
-instance Eq a => Eq (Vector a) where
-  {-# INLINE (==) #-}
-  (==) = coerce ((==) @(V.Vector a))
-
--- See NOTE: [GND for strict vector]
-instance Ord a => Ord (Vector a) where
-  {-# INLINE compare #-}
-  compare = coerce (compare @(V.Vector a))
-  {-# INLINE (<) #-}
-  (<)  = coerce ((<)  @(V.Vector a))
-  {-# INLINE (<=) #-}
-  (<=) = coerce ((<=) @(V.Vector a))
-  {-# INLINE (>) #-}
-  (>)  = coerce ((>)  @(V.Vector a))
-  {-# INLINE (>=) #-}
-  (>=) = coerce ((>=) @(V.Vector a))
-
-instance Eq1 Vector where
-  {-# INLINE liftEq #-}
-  liftEq = eqBy
-
-instance Ord1 Vector where
-  {-# INLINE liftCompare #-}
-  liftCompare = cmpBy
-
-instance Functor Vector where
-  {-# INLINE fmap #-}
-  fmap = map
-
-  {-# INLINE (<$) #-}
-  (<$) = map . const
-
-instance Monad Vector where
-  {-# INLINE return #-}
-  return = Applicative.pure
-
-  {-# INLINE (>>=) #-}
-  (>>=) = flip concatMap
-
--- | @since 0.13.2.0
-instance Fail.MonadFail Vector where
-  {-# INLINE fail #-}
-  fail _ = empty
-
-instance MonadPlus Vector where
-  {-# INLINE mzero #-}
-  mzero = empty
-
-  {-# INLINE mplus #-}
-  mplus = (++)
-
-instance MonadZip Vector where
-  {-# INLINE mzip #-}
-  mzip = zip
-
-  {-# INLINE mzipWith #-}
-  mzipWith = zipWith
-
-  {-# INLINE munzip #-}
-  munzip = unzip
-
--- | This instance has the same semantics as the one for lists.
---
---  @since 0.13.2.0
-instance MonadFix Vector where
-  -- We take care to dispose of v0 as soon as possible (see headM docs).
-  --
-  -- It's perfectly safe to use non-monadic indexing within generate
-  -- call since intermediate vector won't be created until result's
-  -- value is demanded.
-  {-# INLINE mfix #-}
-  mfix f
-    | null v0 = empty
-    -- We take first element of resulting vector from v0 and create
-    -- rest using generate. Note that cons should fuse with generate
-    | otherwise = runST $ do
-        h <- headM v0
-        return $ cons h $
-          generate (lv0 - 1) $
-            \i -> fix (\a -> f a ! (i + 1))
-    where
-      -- Used to calculate size of resulting vector
-      v0 = fix (f . head)
-      !lv0 = length v0
-
-instance Applicative.Applicative Vector where
-  {-# INLINE pure #-}
-  pure = singleton
-
-  {-# INLINE (<*>) #-}
-  (<*>) = ap
-
-instance Applicative.Alternative Vector where
-  {-# INLINE empty #-}
-  empty = empty
-
-  {-# INLINE (<|>) #-}
-  (<|>) = (++)
-
-instance Traversable.Traversable Vector where
-  {-# INLINE traverse #-}
-  traverse = traverse
-
-  {-# INLINE mapM #-}
-  mapM = mapM
-
-  {-# INLINE sequence #-}
-  sequence = sequence
+  ( Eq(..), Ord(..), Num, Enum, Monoid, Monad, Bool, Ordering(..), Int, Maybe, Either
+  , id)
 
 -- Length information
 -- ------------------
@@ -2549,67 +2346,6 @@ iforA_ :: (Applicative f)
 iforA_ = G.iforA_
 
 
--- Conversions - Lazy vectors
--- -----------------------------
-
--- | /O(1)/ Convert strict array to lazy array
-toLazy :: Vector a -> V.Vector a
-toLazy (Vector v) = v
-
--- | /O(n)/ Convert lazy array to strict array. This function reduces
--- each element of vector to WHNF.
-fromLazy :: V.Vector a -> Vector a
-fromLazy vec = liftRnf (`seq` ()) v `seq` v where v = Vector vec
-
-
--- Conversions - Arrays
--- -----------------------------
-
--- | /O(n)/ Convert an array to a vector and reduce each element to WHNF.
---
--- @since 0.13.2.0
-fromArray :: Array a -> Vector a
-{-# INLINE fromArray #-}
-fromArray arr = liftRnf (`seq` ()) vec `seq` vec
-  where
-    vec = Vector $ V.fromArray arr
-
--- | /O(n)/ Convert a vector to an array.
---
--- @since 0.13.2.0
-toArray :: Vector a -> Array a
-{-# INLINE toArray #-}
-toArray (Vector v) = V.toArray v
-
--- | /O(1)/ Extract the underlying `Array`, offset where vector starts and the
--- total number of elements in the vector. Below property always holds:
---
--- > let (array, offset, len) = toArraySlice v
--- > v === unsafeFromArraySlice len offset array
---
--- @since 0.13.2.0
-toArraySlice :: Vector a -> (Array a, Int, Int)
-{-# INLINE toArraySlice #-}
-toArraySlice (Vector v) = V.toArraySlice v
-
-
--- | /O(n)/ Convert an array slice to a vector and reduce each element to WHNF.
---
--- This function is very unsafe, because constructing an invalid
--- vector can yield almost all other safe functions in this module
--- unsafe. These are equivalent:
---
--- > unsafeFromArraySlice len offset === unsafeTake len . unsafeDrop offset . fromArray
---
--- @since 0.13.2.0
-unsafeFromArraySlice ::
-     Array a -- ^ Immutable boxed array.
-  -> Int -- ^ Offset
-  -> Int -- ^ Length
-  -> Vector a
-{-# INLINE unsafeFromArraySlice #-}
-unsafeFromArraySlice arr offset len = liftRnf (`seq` ()) vec `seq` vec
-  where vec = Vector (V.unsafeFromArraySlice arr offset len)
 
 
 
@@ -2687,4 +2423,4 @@ copy = G.copy
 
 -- $setup
 -- >>> :set -Wno-type-defaults
--- >>> import Prelude (Char, String, Bool(True, False), min, max, fst, even, undefined, Ord(..))
+-- >>> import Prelude (Char, String, Bool(..), min, max, fst, even, undefined, Ord(..), (<>), Num(..),($))