Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
313 changes: 6 additions & 307 deletions vector/src/Data/Vector.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,6 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module : Data.Vector
-- Copyright : (c) Roman Leshchinskiy 2008-2010
Expand Down Expand Up @@ -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
-- ------------------
Expand Down Expand Up @@ -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
-- -----------------------------

Expand Down Expand Up @@ -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(..))
Loading
Loading