Lazy boxed: add Unsafe modules

Author: Shimuuar

vector/src/Data/Vector.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeFamilies #-}
-
 -- |
 -- Module      : Data.Vector
 -- Copyright   : (c) Roman Leshchinskiy 2008-2010
@@ -179,275 +178,21 @@ module Data.Vector (
 ) where
 
 import Control.Applicative (Applicative)
-import Data.Vector.Mutable  ( MVector(..) )
-import Data.Primitive.Array
-import qualified Data.Vector.Fusion.Bundle as Bundle
+import Data.Vector.Mutable.Unsafe ( MVector )
+import Data.Vector.Unsafe
 import qualified Data.Vector.Generic as G
 
-import Control.DeepSeq ( NFData(rnf), NFData1(liftRnf))
-
-import Control.Monad ( MonadPlus(..), liftM, ap )
-import Control.Monad.ST ( ST, runST )
+import Control.Monad.ST ( ST )
 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 Prelude
-  ( Eq, Ord, Num, Enum, Monoid, Functor, Monad, Show, Bool, Ordering(..), Int, Maybe, Either
-  , compare, mempty, mappend, mconcat, return, showsPrec, fmap, otherwise, id, flip, const
-  , (>>=), (+), (-), (<), (<=), (>), (>=), (==), (/=), (&&), (.), ($) )
+  ( Eq, Ord, Num, Enum, Monoid, Monad, Bool, Ordering(..), Int, Maybe, Either
+  , id, (==))
 
-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(..))
-
-
--- | Boxed vectors, supporting efficient slicing.
-data Vector a = Vector {-# UNPACK #-} !Int
-                       {-# UNPACK #-} !Int
-                       {-# UNPACK #-} !(Array a)
-
-instance NFData a => NFData (Vector a) where
-  rnf = liftRnf rnf
-  {-# INLINEABLE rnf #-}
-
--- | @since 0.12.1.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.fromList
-  fromListN = Data.Vector.fromListN
-  toList = toList
-
-instance Data a => Data (Vector a) where
-  gfoldl       = G.gfoldl
-  toConstr _   = G.mkVecConstr "Data.Vector.Vector"
-  gunfold      = G.gunfold
-  dataTypeOf _ = G.mkVecType "Data.Vector.Vector"
-  dataCast1    = G.dataCast
-
-type instance G.Mutable Vector = MVector
-
-instance G.Vector Vector a where
-  {-# INLINE basicUnsafeFreeze #-}
-  basicUnsafeFreeze (MVector i n marr)
-    = Vector i n `liftM` unsafeFreezeArray marr
-
-  {-# INLINE basicUnsafeThaw #-}
-  basicUnsafeThaw (Vector i n arr)
-    = MVector i n `liftM` unsafeThawArray 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 = indexArrayM arr (i+j)
-
-  {-# INLINE basicUnsafeCopy #-}
-  basicUnsafeCopy (MVector i n dst) (Vector j _ src)
-    = copyArray dst i src j n
-
--- See http://trac.haskell.org/vector/ticket/12
-instance 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 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 Eq1 Vector where
-  {-# INLINE liftEq #-}
-  liftEq = eqBy
-
-instance Ord1 Vector where
-  {-# INLINE liftCompare #-}
-  liftCompare = cmpBy
-
-instance Semigroup (Vector a) where
-  {-# INLINE (<>) #-}
-  (<>) = (++)
-
-  {-# INLINE sconcat #-}
-  sconcat = G.concatNE
-
-instance Monoid (Vector a) where
-  {-# INLINE mempty #-}
-  mempty = empty
-
-  {-# INLINE mappend #-}
-  mappend = (<>)
-
-  {-# INLINE mconcat #-}
-  mconcat = concat
-
-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.12.1.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.12.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 Foldable.Foldable Vector where
-  {-# INLINE foldr #-}
-  foldr = foldr
-
-  {-# INLINE foldl #-}
-  foldl = foldl
-
-  {-# INLINE foldr1 #-}
-  foldr1 = foldr1
-
-  {-# INLINE foldl1 #-}
-  foldl1 = foldl1
-
-  {-# INLINE foldr' #-}
-  foldr' = foldr'
-
-  {-# INLINE foldl' #-}
-  foldl' = foldl'
-
-  {-# INLINE toList #-}
-  toList = toList
-
-  {-# INLINE length #-}
-  length = length
-
-  {-# INLINE null #-}
-  null = null
-
-  {-# INLINE elem #-}
-  elem = elem
-
-  {-# INLINE maximum #-}
-  maximum = maximum
-
-  {-# INLINE minimum #-}
-  minimum = minimum
-
-  {-# INLINE sum #-}
-  sum = sum
-
-  {-# INLINE product #-}
-  product = product
-
-instance Traversable.Traversable Vector where
-  {-# INLINE traverse #-}
-  traverse = traverse
-
-  {-# INLINE mapM #-}
-  mapM = mapM
-
-  {-# INLINE sequence #-}
-  sequence = sequence
 
 -- Length information
 -- ------------------
@@ -2281,52 +2026,6 @@ iforA_ :: (Applicative f)
 iforA_ = G.iforA_
 
 
--- Conversions - Arrays
--- -----------------------------
-
--- | /O(1)/ Convert an array to a vector.
---
--- @since 0.12.2.0
-fromArray :: Array a -> Vector a
-{-# INLINE fromArray #-}
-fromArray arr = Vector 0 (sizeofArray arr) arr
-
--- | /O(n)/ Convert a vector to an array.
---
--- @since 0.12.2.0
-toArray :: Vector a -> Array a
-{-# INLINE toArray #-}
-toArray (Vector offset len arr)
-  | offset == 0 && len == sizeofArray arr = arr
-  | otherwise = cloneArray arr offset len
-
--- | /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.0.0
-toArraySlice :: Vector a -> (Array a, Int, Int)
-{-# INLINE toArraySlice #-}
-toArraySlice (Vector offset len arr) = (arr, offset, len)
-
-
--- | /O(1)/ Convert an array slice to a vector. 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.0.0
-unsafeFromArraySlice ::
-     Array a -- ^ Immutable boxed array.
-  -> Int -- ^ Offset
-  -> Int -- ^ Length
-  -> Vector a
-{-# INLINE unsafeFromArraySlice #-}
-unsafeFromArraySlice arr offset len = Vector offset len arr
-
 -- Conversions - Mutable vectors
 -- -----------------------------
 
@@ -2389,4 +2088,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(True, False), min, max, fst, even, undefined, Ord(..), ($), (<>), Num(..))