diff options
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/vector')
54 files changed, 19183 insertions, 0 deletions
diff --git a/third_party/bazel/rules_haskell/examples/vector/BUILD.bazel b/third_party/bazel/rules_haskell/examples/vector/BUILD.bazel new file mode 100644 index 0000000000..7c00806efe --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/BUILD.bazel @@ -0,0 +1,38 @@ +load( + "@io_tweag_rules_haskell//haskell:haskell.bzl", + "haskell_cc_import", + "haskell_library", + "haskell_toolchain_library", +) + +haskell_toolchain_library(name = "base") + +haskell_toolchain_library(name = "deepseq") + +haskell_toolchain_library(name = "ghc-prim") + +haskell_toolchain_library(name = "primitive") + +haskell_toolchain_library(name = "semigroups") + +haskell_library( + name = "vector", + testonly = 1, + srcs = glob(["Data/**/*.*hs"]), + compiler_flags = [ + "-Iexternal/io_tweag_rules_haskell_examples/vector/include", + "-Iexternal/io_tweag_rules_haskell_examples/vector/internal", + ], + extra_srcs = [ + "include/vector.h", + "internal/unbox-tuple-instances", + ], + version = "0", + visibility = ["//visibility:public"], + deps = [ + ":base", + ":deepseq", + ":ghc-prim", + "//primitive", + ], +) diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector.hs new file mode 100644 index 0000000000..21b61960ca --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector.hs @@ -0,0 +1,1719 @@ +{-# LANGUAGE CPP + , DeriveDataTypeable + , FlexibleInstances + , MultiParamTypeClasses + , TypeFamilies + , Rank2Types + , BangPatterns + #-} + +-- | +-- Module : Data.Vector +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- A library for boxed vectors (that is, polymorphic arrays capable of +-- holding any Haskell value). The vectors come in two flavours: +-- +-- * mutable +-- +-- * immutable +-- +-- and support a rich interface of both list-like operations, and bulk +-- array operations. +-- +-- For unboxed arrays, use "Data.Vector.Unboxed" +-- + +module Data.Vector ( + -- * Boxed vectors + Vector, MVector, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + unsafeIndex, unsafeHead, unsafeLast, + + -- ** Monadic indexing + indexM, headM, lastM, + unsafeIndexM, unsafeHeadM, unsafeLastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, iterateNM, create, createT, + + -- ** Unfolding + unfoldr, unfoldrN, + unfoldrM, unfoldrNM, + constructN, constructrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update, update_, + unsafeUpd, unsafeUpdate, unsafeUpdate_, + + -- ** Accumulations + accum, accumulate, accumulate_, + unsafeAccum, unsafeAccumulate, unsafeAccumulate_, + + -- ** Permutations + reverse, backpermute, unsafeBackpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Indexing + indexed, + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, imapM, mapM_, imapM_, forM, forM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + zip, zip3, zip4, zip5, zip6, + + -- ** Monadic zipping + zipWithM, izipWithM, zipWithM_, izipWithM_, + + -- ** Unzipping + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, uniq, + mapMaybe, imapMaybe, + filterM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, span, break, + + -- ** Searching + elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + + -- ** Specialised folds + all, any, and, or, + sum, product, + maximum, maximumBy, minimum, minimumBy, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, ifoldM, foldM', ifoldM', + fold1M, fold1M',foldM_, ifoldM_, + foldM'_, ifoldM'_, fold1M_, fold1M'_, + + -- ** Monadic sequencing + sequence, sequence_, + + -- * Prefix sums (scans) + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + iscanl, iscanl', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + iscanr, iscanr', + + -- * Conversions + + -- ** Lists + toList, Data.Vector.fromList, Data.Vector.fromListN, + + -- ** Other vector types + G.convert, + + -- ** Mutable vectors + freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy +) where + +import qualified Data.Vector.Generic as G +import Data.Vector.Mutable ( MVector(..) ) +import Data.Primitive.Array +import qualified Data.Vector.Fusion.Bundle as Bundle + +import Control.DeepSeq ( NFData, rnf ) +import Control.Monad ( MonadPlus(..), liftM, ap ) +import Control.Monad.ST ( ST ) +import Control.Monad.Primitive + + +import Control.Monad.Zip + +import Prelude hiding ( length, null, + replicate, (++), concat, + head, last, + init, tail, take, drop, splitAt, reverse, + map, concatMap, + zipWith, zipWith3, zip, zip3, unzip, unzip3, + filter, takeWhile, dropWhile, span, break, + elem, notElem, + foldl, foldl1, foldr, foldr1, + all, any, and, or, sum, product, minimum, maximum, + scanl, scanl1, scanr, scanr1, + enumFromTo, enumFromThenTo, + mapM, mapM_, sequence, sequence_ ) + +#if MIN_VERSION_base(4,9,0) +import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..)) +#endif + +import Data.Typeable ( Typeable ) +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 + +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid ( Monoid(..) ) +#endif + +#if __GLASGOW_HASKELL__ >= 708 +import qualified GHC.Exts as Exts (IsList(..)) +#endif + + +-- | Boxed vectors, supporting efficient slicing. +data Vector a = Vector {-# UNPACK #-} !Int + {-# UNPACK #-} !Int + {-# UNPACK #-} !(Array a) + deriving ( Typeable ) + +instance NFData a => NFData (Vector a) where + rnf (Vector i n arr) = rnfAll i + where + rnfAll ix | ix < n = rnf (indexArray arr ix) `seq` rnfAll (ix+1) + | otherwise = () + +instance Show a => Show (Vector a) where + showsPrec = G.showsPrec + +instance Read a => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + +#if MIN_VERSION_base(4,9,0) +instance Show1 Vector where + liftShowsPrec = G.liftShowsPrec + +instance Read1 Vector where + liftReadsPrec = G.liftReadsPrec +#endif + +#if __GLASGOW_HASKELL__ >= 708 + +instance Exts.IsList (Vector a) where + type Item (Vector a) = a + fromList = Data.Vector.fromList + fromListN = Data.Vector.fromListN + toList = toList +#endif + +instance Data a => Data (Vector a) where + gfoldl = G.gfoldl + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = G.mkType "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) + + {-# INLINE (/=) #-} + xs /= ys = not (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 + +#if MIN_VERSION_base(4,9,0) +instance Eq1 Vector where + liftEq eq xs ys = Bundle.eqBy eq (G.stream xs) (G.stream ys) + +instance Ord1 Vector where + liftCompare cmp xs ys = Bundle.cmpBy cmp (G.stream xs) (G.stream ys) +#endif + +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 + +instance Monad Vector where + {-# INLINE return #-} + return = Applicative.pure + + {-# INLINE (>>=) #-} + (>>=) = flip concatMap + + {-# 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 + + +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 + +#if MIN_VERSION_base(4,6,0) + {-# INLINE foldr' #-} + foldr' = foldr' + + {-# INLINE foldl' #-} + foldl' = foldl' +#endif + +#if MIN_VERSION_base(4,8,0) + {-# 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 +#endif + +instance Traversable.Traversable Vector where + {-# INLINE traverse #-} + traverse f xs = Data.Vector.fromList Applicative.<$> Traversable.traverse f (toList xs) + + {-# INLINE mapM #-} + mapM = mapM + + {-# INLINE sequence #-} + sequence = sequence + +-- Length information +-- ------------------ + +-- | /O(1)/ Yield the length of the vector +length :: Vector a -> Int +{-# INLINE length #-} +length = G.length + +-- | /O(1)/ Test whether a vector is empty +null :: Vector a -> Bool +{-# INLINE null #-} +null = G.null + +-- Indexing +-- -------- + +-- | O(1) Indexing +(!) :: Vector a -> Int -> a +{-# INLINE (!) #-} +(!) = (G.!) + +-- | O(1) Safe indexing +(!?) :: Vector a -> Int -> Maybe a +{-# INLINE (!?) #-} +(!?) = (G.!?) + +-- | /O(1)/ First element +head :: Vector a -> a +{-# INLINE head #-} +head = G.head + +-- | /O(1)/ Last element +last :: Vector a -> a +{-# INLINE last #-} +last = G.last + +-- | /O(1)/ Unsafe indexing without bounds checking +unsafeIndex :: Vector a -> Int -> a +{-# INLINE unsafeIndex #-} +unsafeIndex = G.unsafeIndex + +-- | /O(1)/ First element without checking if the vector is empty +unsafeHead :: Vector a -> a +{-# INLINE unsafeHead #-} +unsafeHead = G.unsafeHead + +-- | /O(1)/ Last element without checking if the vector is empty +unsafeLast :: Vector a -> a +{-# INLINE unsafeLast #-} +unsafeLast = G.unsafeLast + +-- Monadic indexing +-- ---------------- + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the vector when necessary. +-- Suppose vector copying is implemented like this: +-- +-- > copy mv v = ... write mv i (v ! i) ... +-- +-- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ +-- would unnecessarily retain a reference to @v@ in each element written. +-- +-- With 'indexM', copying can be implemented like this instead: +-- +-- > copy mv v = ... do +-- > x <- indexM v i +-- > write mv i x +-- +-- Here, no references to @v@ are retained because indexing (but /not/ the +-- elements) is evaluated eagerly. +-- +indexM :: Monad m => Vector a -> Int -> m a +{-# INLINE indexM #-} +indexM = G.indexM + +-- | /O(1)/ First element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +headM :: Monad m => Vector a -> m a +{-# INLINE headM #-} +headM = G.headM + +-- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +lastM :: Monad m => Vector a -> m a +{-# INLINE lastM #-} +lastM = G.lastM + +-- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an +-- explanation of why this is useful. +unsafeIndexM :: Monad m => Vector a -> Int -> m a +{-# INLINE unsafeIndexM #-} +unsafeIndexM = G.unsafeIndexM + +-- | /O(1)/ First element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeHeadM :: Monad m => Vector a -> m a +{-# INLINE unsafeHeadM #-} +unsafeHeadM = G.unsafeHeadM + +-- | /O(1)/ Last element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeLastM :: Monad m => Vector a -> m a +{-# INLINE unsafeLastM #-} +unsafeLastM = G.unsafeLastM + +-- Extracting subvectors (slicing) +-- ------------------------------- + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE slice #-} +slice = G.slice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty. +init :: Vector a -> Vector a +{-# INLINE init #-} +init = G.init + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty. +tail :: Vector a -> Vector a +{-# INLINE tail #-} +tail = G.tail + +-- | /O(1)/ Yield at the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case it is returned unchanged. +take :: Int -> Vector a -> Vector a +{-# INLINE take #-} +take = G.take + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case an empty vector is returned. +drop :: Int -> Vector a -> Vector a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ +-- but slightly more efficient. +{-# INLINE splitAt #-} +splitAt :: Int -> Vector a -> (Vector a, Vector a) +splitAt = G.splitAt + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must +-- contain at least @i+n@ elements but this is not checked. +unsafeSlice :: Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty but this is not checked. +unsafeInit :: Vector a -> Vector a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty but this is not checked. +unsafeTail :: Vector a -> Vector a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector must +-- contain at least @n@ elements but this is not checked. +unsafeTake :: Int -> Vector a -> Vector a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector +-- must contain at least @n@ elements but this is not checked. +unsafeDrop :: Int -> Vector a -> Vector a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- Initialisation +-- -------------- + +-- | /O(1)/ Empty vector +empty :: Vector a +{-# INLINE empty #-} +empty = G.empty + +-- | /O(1)/ Vector with exactly one element +singleton :: a -> Vector a +{-# INLINE singleton #-} +singleton = G.singleton + +-- | /O(n)/ Vector of the given length with the same value in each position +replicate :: Int -> a -> Vector a +{-# INLINE replicate #-} +replicate = G.replicate + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index +generate :: Int -> (Int -> a) -> Vector a +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Apply function n times to value. Zeroth element is original value. +iterateN :: Int -> (a -> a) -> a -> Vector a +{-# INLINE iterateN #-} +iterateN = G.iterateN + +-- Unfolding +-- --------- + +-- | /O(n)/ Construct a vector by repeatedly applying the generator function +-- to a seed. The generator function yields 'Just' the next element and the +-- new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 +-- > = <10,9,8,7,6,5,4,3,2,1> +unfoldr :: (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldr #-} +unfoldr = G.unfoldr + +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> +unfoldrN :: Int -> (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldrN #-} +unfoldrN = G.unfoldrN + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in f <a,b,c> +-- +constructN :: Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in f <c,b,a> +-- +constructrN :: Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN + +-- Enumeration +-- ----------- + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ +-- etc. This operation is usually more efficient than 'enumFromTo'. +-- +-- > enumFromN 5 3 = <5,6,7> +enumFromN :: Num a => a -> Int -> Vector a +{-# INLINE enumFromN #-} +enumFromN = G.enumFromN + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, +-- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. +-- +-- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> +enumFromStepN :: Num a => a -> a -> Int -> Vector a +{-# INLINE enumFromStepN #-} +enumFromStepN = G.enumFromStepN + +-- | /O(n)/ Enumerate values from @x@ to @y@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromN' instead. +enumFromTo :: Enum a => a -> a -> Vector a +{-# INLINE enumFromTo #-} +enumFromTo = G.enumFromTo + +-- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: Enum a => a -> a -> a -> Vector a +{-# INLINE enumFromThenTo #-} +enumFromThenTo = G.enumFromThenTo + +-- Concatenation +-- ------------- + +-- | /O(n)/ Prepend an element +cons :: a -> Vector a -> Vector a +{-# INLINE cons #-} +cons = G.cons + +-- | /O(n)/ Append an element +snoc :: Vector a -> a -> Vector a +{-# INLINE snoc #-} +snoc = G.snoc + +infixr 5 ++ +-- | /O(m+n)/ Concatenate two vectors +(++) :: Vector a -> Vector a -> Vector a +{-# INLINE (++) #-} +(++) = (G.++) + +-- | /O(n)/ Concatenate all vectors in the list +concat :: [Vector a] -> Vector a +{-# INLINE concat #-} +concat = G.concat + +-- Monadic initialisation +-- ---------------------- + +-- | /O(n)/ Execute the monadic action the given number of times and store the +-- results in a vector. +replicateM :: Monad m => Int -> m a -> m (Vector a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +generateM :: Monad m => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: Monad m => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + +-- | Execute the monadic action and freeze the resulting vector. +-- +-- @ +-- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> +-- @ +create :: (forall s. ST s (MVector s a)) -> Vector a +{-# INLINE create #-} +-- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 +create p = G.create p + +-- | Execute the monadic action and freeze the resulting vectors. +createT :: Traversable.Traversable f => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + + + +-- Restricting memory usage +-- ------------------------ + +-- | /O(n)/ Yield the argument but force it not to retain any extra memory, +-- possibly by copying it. +-- +-- This is especially useful when dealing with slices. For example: +-- +-- > force (slice 0 2 <huge vector>) +-- +-- Here, the slice retains a reference to the huge vector. Forcing it creates +-- a copy of just the elements that belong to the slice and allows the huge +-- vector to be garbage collected. +force :: Vector a -> Vector a +{-# INLINE force #-} +force = G.force + +-- Bulk updates +-- ------------ + +-- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector +-- element at position @i@ by @a@. +-- +-- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> +-- +(//) :: Vector a -- ^ initial vector (of length @m@) + -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE (//) #-} +(//) = (G.//) + +-- | /O(m+n)/ For each pair @(i,a)@ from the vector of index/value pairs, +-- replace the vector element at position @i@ by @a@. +-- +-- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7> +-- +update :: Vector a -- ^ initial vector (of length @m@) + -> Vector (Int, a) -- ^ vector of index/value pairs (of length @n@) + -> Vector a +{-# INLINE update #-} +update = G.update + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @a@ from the value vector, replace the element of the +-- initial vector at position @i@ by @a@. +-- +-- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> +-- +-- The function 'update' provides the same functionality and is usually more +-- convenient. +-- +-- @ +-- update_ xs is ys = 'update' xs ('zip' is ys) +-- @ +update_ :: Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector a -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE update_ #-} +update_ = G.update_ + +-- | Same as ('//') but without bounds checking. +unsafeUpd :: Vector a -> [(Int, a)] -> Vector a +{-# INLINE unsafeUpd #-} +unsafeUpd = G.unsafeUpd + +-- | Same as 'update' but without bounds checking. +unsafeUpdate :: Vector a -> Vector (Int, a) -> Vector a +{-# INLINE unsafeUpdate #-} +unsafeUpdate = G.unsafeUpdate + +-- | Same as 'update_' but without bounds checking. +unsafeUpdate_ :: Vector a -> Vector Int -> Vector a -> Vector a +{-# INLINE unsafeUpdate_ #-} +unsafeUpdate_ = G.unsafeUpdate_ + +-- Accumulations +-- ------------- + +-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element +-- @a@ at position @i@ by @f a b@. +-- +-- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> +accum :: (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accum #-} +accum = G.accum + +-- | /O(m+n)/ For each pair @(i,b)@ from the vector of pairs, replace the vector +-- element @a@ at position @i@ by @f a b@. +-- +-- > accumulate (+) <5,9,2> <(2,4),(1,6),(0,3),(1,7)> = <5+3, 9+6+7, 2+4> +accumulate :: (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector (Int,b) -- ^ vector of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accumulate #-} +accumulate = G.accumulate + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the the value vector, +-- replace the element of the initial vector at +-- position @i@ by @f a b@. +-- +-- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> +-- +-- The function 'accumulate' provides the same functionality and is usually more +-- convenient. +-- +-- @ +-- accumulate_ f as is bs = 'accumulate' f as ('zip' is bs) +-- @ +accumulate_ :: (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector b -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE accumulate_ #-} +accumulate_ = G.accumulate_ + +-- | Same as 'accum' but without bounds checking. +unsafeAccum :: (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a +{-# INLINE unsafeAccum #-} +unsafeAccum = G.unsafeAccum + +-- | Same as 'accumulate' but without bounds checking. +unsafeAccumulate :: (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a +{-# INLINE unsafeAccumulate #-} +unsafeAccumulate = G.unsafeAccumulate + +-- | Same as 'accumulate_' but without bounds checking. +unsafeAccumulate_ + :: (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a +{-# INLINE unsafeAccumulate_ #-} +unsafeAccumulate_ = G.unsafeAccumulate_ + +-- Permutations +-- ------------ + +-- | /O(n)/ Reverse a vector +reverse :: Vector a -> Vector a +{-# INLINE reverse #-} +reverse = G.reverse + +-- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the +-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is +-- often much more efficient. +-- +-- > backpermute <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a> +backpermute :: Vector a -> Vector Int -> Vector a +{-# INLINE backpermute #-} +backpermute = G.backpermute + +-- | Same as 'backpermute' but without bounds checking. +unsafeBackpermute :: Vector a -> Vector Int -> Vector a +{-# INLINE unsafeBackpermute #-} +unsafeBackpermute = G.unsafeBackpermute + +-- Safe destructive updates +-- ------------------------ + +-- | Apply a destructive operation to a vector. The operation will be +-- performed in place if it is safe to do so and will modify a copy of the +-- vector otherwise. +-- +-- @ +-- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> +-- @ +modify :: (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a +{-# INLINE modify #-} +modify p = G.modify p + +-- Indexing +-- -------- + +-- | /O(n)/ Pair each element in a vector with its index +indexed :: Vector a -> Vector (Int,a) +{-# INLINE indexed #-} +indexed = G.indexed + +-- Mapping +-- ------- + +-- | /O(n)/ Map a function over a vector +map :: (a -> b) -> Vector a -> Vector b +{-# INLINE map #-} +map = G.map + +-- | /O(n)/ Apply a function to every element of a vector and its index +imap :: (Int -> a -> b) -> Vector a -> Vector b +{-# INLINE imap #-} +imap = G.imap + +-- | Map a function over a vector and concatenate the results. +concatMap :: (a -> Vector b) -> Vector a -> Vector b +{-# INLINE concatMap #-} +concatMap = G.concatMap + +-- Monadic mapping +-- --------------- + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results +mapM :: Monad m => (a -> m b) -> Vector a -> m (Vector b) +{-# INLINE mapM #-} +mapM = G.mapM + +-- | /O(n)/ Apply the monadic action to every element of a vector and its +-- index, yielding a vector of results +imapM :: Monad m => (Int -> a -> m b) -> Vector a -> m (Vector b) +{-# INLINE imapM #-} +imapM = G.imapM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results +mapM_ :: Monad m => (a -> m b) -> Vector a -> m () +{-# INLINE mapM_ #-} +mapM_ = G.mapM_ + +-- | /O(n)/ Apply the monadic action to every element of a vector and its +-- index, ignoring the results +imapM_ :: Monad m => (Int -> a -> m b) -> Vector a -> m () +{-# INLINE imapM_ #-} +imapM_ = G.imapM_ + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results. Equivalent to @flip 'mapM'@. +forM :: Monad m => Vector a -> (a -> m b) -> m (Vector b) +{-# INLINE forM #-} +forM = G.forM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results. Equivalent to @flip 'mapM_'@. +forM_ :: Monad m => Vector a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- Zipping +-- ------- + +-- | /O(min(m,n))/ Zip two vectors with the given function. +zipWith :: (a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE zipWith #-} +zipWith = G.zipWith + +-- | Zip three vectors with the given function. +zipWith3 :: (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE zipWith3 #-} +zipWith3 = G.zipWith3 + +zipWith4 :: (a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE zipWith4 #-} +zipWith4 = G.zipWith4 + +zipWith5 :: (a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE zipWith5 #-} +zipWith5 = G.zipWith5 + +zipWith6 :: (a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE zipWith6 #-} +zipWith6 = G.zipWith6 + +-- | /O(min(m,n))/ Zip two vectors with a function that also takes the +-- elements' indices. +izipWith :: (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE izipWith #-} +izipWith = G.izipWith + +-- | Zip three vectors and their indices with the given function. +izipWith3 :: (Int -> a -> b -> c -> d) + -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE izipWith3 #-} +izipWith3 = G.izipWith3 + +izipWith4 :: (Int -> a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE izipWith4 #-} +izipWith4 = G.izipWith4 + +izipWith5 :: (Int -> a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE izipWith5 #-} +izipWith5 = G.izipWith5 + +izipWith6 :: (Int -> a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE izipWith6 #-} +izipWith6 = G.izipWith6 + +-- | Elementwise pairing of array elements. +zip :: Vector a -> Vector b -> Vector (a, b) +{-# INLINE zip #-} +zip = G.zip + +-- | zip together three vectors into a vector of triples +zip3 :: Vector a -> Vector b -> Vector c -> Vector (a, b, c) +{-# INLINE zip3 #-} +zip3 = G.zip3 + +zip4 :: Vector a -> Vector b -> Vector c -> Vector d + -> Vector (a, b, c, d) +{-# INLINE zip4 #-} +zip4 = G.zip4 + +zip5 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector (a, b, c, d, e) +{-# INLINE zip5 #-} +zip5 = G.zip5 + +zip6 :: Vector a -> Vector b -> Vector c -> Vector d -> Vector e -> Vector f + -> Vector (a, b, c, d, e, f) +{-# INLINE zip6 #-} +zip6 = G.zip6 + +-- Unzipping +-- --------- + +-- | /O(min(m,n))/ Unzip a vector of pairs. +unzip :: Vector (a, b) -> (Vector a, Vector b) +{-# INLINE unzip #-} +unzip = G.unzip + +unzip3 :: Vector (a, b, c) -> (Vector a, Vector b, Vector c) +{-# INLINE unzip3 #-} +unzip3 = G.unzip3 + +unzip4 :: Vector (a, b, c, d) -> (Vector a, Vector b, Vector c, Vector d) +{-# INLINE unzip4 #-} +unzip4 = G.unzip4 + +unzip5 :: Vector (a, b, c, d, e) + -> (Vector a, Vector b, Vector c, Vector d, Vector e) +{-# INLINE unzip5 #-} +unzip5 = G.unzip5 + +unzip6 :: Vector (a, b, c, d, e, f) + -> (Vector a, Vector b, Vector c, Vector d, Vector e, Vector f) +{-# INLINE unzip6 #-} +unzip6 = G.unzip6 + +-- Monadic zipping +-- --------------- + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a +-- vector of results +zipWithM :: Monad m => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +{-# INLINE zipWithM #-} +zipWithM = G.zipWithM + +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes +-- the element index and yield a vector of results +izipWithM :: Monad m => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +{-# INLINE izipWithM #-} +izipWithM = G.izipWithM + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the +-- results +zipWithM_ :: Monad m => (a -> b -> m c) -> Vector a -> Vector b -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ = G.zipWithM_ + +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes +-- the element index and ignore the results +izipWithM_ :: Monad m => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m () +{-# INLINE izipWithM_ #-} +izipWithM_ = G.izipWithM_ + +-- Filtering +-- --------- + +-- | /O(n)/ Drop elements that do not satisfy the predicate +filter :: (a -> Bool) -> Vector a -> Vector a +{-# INLINE filter #-} +filter = G.filter + +-- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to +-- values and their indices +ifilter :: (Int -> a -> Bool) -> Vector a -> Vector a +{-# INLINE ifilter #-} +ifilter = G.ifilter + +-- | /O(n)/ Drop repeated adjacent elements. +uniq :: (Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + +-- | /O(n)/ Drop elements when predicate returns Nothing +mapMaybe :: (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing +imapMaybe :: (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + +-- | /O(n)/ Drop elements that do not satisfy the monadic predicate +filterM :: Monad m => (a -> m Bool) -> Vector a -> m (Vector a) +{-# INLINE filterM #-} +filterM = G.filterM + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate +-- without copying. +takeWhile :: (a -> Bool) -> Vector a -> Vector a +{-# INLINE takeWhile #-} +takeWhile = G.takeWhile + +-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate +-- without copying. +dropWhile :: (a -> Bool) -> Vector a -> Vector a +{-# INLINE dropWhile #-} +dropWhile = G.dropWhile + +-- Parititioning +-- ------------- + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. The +-- relative order of the elements is preserved at the cost of a sometimes +-- reduced performance compared to 'unstablePartition'. +partition :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE partition #-} +partition = G.partition + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. +-- The order of the elements is not preserved but the operation is often +-- faster than 'partition'. +unstablePartition :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE unstablePartition #-} +unstablePartition = G.unstablePartition + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +span :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE span #-} +span = G.span + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +break :: (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE break #-} +break = G.break + +-- Searching +-- --------- + +infix 4 `elem` +-- | /O(n)/ Check if the vector contains an element +elem :: Eq a => a -> Vector a -> Bool +{-# INLINE elem #-} +elem = G.elem + +infix 4 `notElem` +-- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') +notElem :: Eq a => a -> Vector a -> Bool +{-# INLINE notElem #-} +notElem = G.notElem + +-- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' +-- if no such element exists. +find :: (a -> Bool) -> Vector a -> Maybe a +{-# INLINE find #-} +find = G.find + +-- | /O(n)/ Yield 'Just' the index of the first element matching the predicate +-- or 'Nothing' if no such element exists. +findIndex :: (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndex #-} +findIndex = G.findIndex + +-- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending +-- order. +findIndices :: (a -> Bool) -> Vector a -> Vector Int +{-# INLINE findIndices #-} +findIndices = G.findIndices + +-- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or +-- 'Nothing' if the vector does not contain the element. This is a specialised +-- version of 'findIndex'. +elemIndex :: Eq a => a -> Vector a -> Maybe Int +{-# INLINE elemIndex #-} +elemIndex = G.elemIndex + +-- | /O(n)/ Yield the indices of all occurences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +elemIndices :: Eq a => a -> Vector a -> Vector Int +{-# INLINE elemIndices #-} +elemIndices = G.elemIndices + +-- Folding +-- ------- + +-- | /O(n)/ Left fold +foldl :: (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Left fold on non-empty vectors +foldl1 :: (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1 #-} +foldl1 = G.foldl1 + +-- | /O(n)/ Left fold with strict accumulator +foldl' :: (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Left fold on non-empty vectors with strict accumulator +foldl1' :: (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1' #-} +foldl1' = G.foldl1' + +-- | /O(n)/ Right fold +foldr :: (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Right fold on non-empty vectors +foldr1 :: (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1 #-} +foldr1 = G.foldr1 + +-- | /O(n)/ Right fold with a strict accumulator +foldr' :: (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Right fold on non-empty vectors with strict accumulator +foldr1' :: (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1' #-} +foldr1' = G.foldr1' + +-- | /O(n)/ Left fold (function applied to each element and its index) +ifoldl :: (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Left fold with strict accumulator (function applied to each element +-- and its index) +ifoldl' :: (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Right fold (function applied to each element and its index) +ifoldr :: (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Right fold with strict accumulator (function applied to each +-- element and its index) +ifoldr' :: (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- Specialised folds +-- ----------------- + +-- | /O(n)/ Check if all elements satisfy the predicate. +all :: (a -> Bool) -> Vector a -> Bool +{-# INLINE all #-} +all = G.all + +-- | /O(n)/ Check if any element satisfies the predicate. +any :: (a -> Bool) -> Vector a -> Bool +{-# INLINE any #-} +any = G.any + +-- | /O(n)/ Check if all elements are 'True' +and :: Vector Bool -> Bool +{-# INLINE and #-} +and = G.and + +-- | /O(n)/ Check if any element is 'True' +or :: Vector Bool -> Bool +{-# INLINE or #-} +or = G.or + +-- | /O(n)/ Compute the sum of the elements +sum :: Num a => Vector a -> a +{-# INLINE sum #-} +sum = G.sum + +-- | /O(n)/ Compute the produce of the elements +product :: Num a => Vector a -> a +{-# INLINE product #-} +product = G.product + +-- | /O(n)/ Yield the maximum element of the vector. The vector may not be +-- empty. +maximum :: Ord a => Vector a -> a +{-# INLINE maximum #-} +maximum = G.maximum + +-- | /O(n)/ Yield the maximum element of the vector according to the given +-- comparison function. The vector may not be empty. +maximumBy :: (a -> a -> Ordering) -> Vector a -> a +{-# INLINE maximumBy #-} +maximumBy = G.maximumBy + +-- | /O(n)/ Yield the minimum element of the vector. The vector may not be +-- empty. +minimum :: Ord a => Vector a -> a +{-# INLINE minimum #-} +minimum = G.minimum + +-- | /O(n)/ Yield the minimum element of the vector according to the given +-- comparison function. The vector may not be empty. +minimumBy :: (a -> a -> Ordering) -> Vector a -> a +{-# INLINE minimumBy #-} +minimumBy = G.minimumBy + +-- | /O(n)/ Yield the index of the maximum element of the vector. The vector +-- may not be empty. +maxIndex :: Ord a => Vector a -> Int +{-# INLINE maxIndex #-} +maxIndex = G.maxIndex + +-- | /O(n)/ Yield the index of the maximum element of the vector according to +-- the given comparison function. The vector may not be empty. +maxIndexBy :: (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE maxIndexBy #-} +maxIndexBy = G.maxIndexBy + +-- | /O(n)/ Yield the index of the minimum element of the vector. The vector +-- may not be empty. +minIndex :: Ord a => Vector a -> Int +{-# INLINE minIndex #-} +minIndex = G.minIndex + +-- | /O(n)/ Yield the index of the minimum element of the vector according to +-- the given comparison function. The vector may not be empty. +minIndexBy :: (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE minIndexBy #-} +minIndexBy = G.minIndexBy + +-- Monadic folds +-- ------------- + +-- | /O(n)/ Monadic fold +foldM :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold (action applied to each element and its index) +ifoldM :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m a +{-# INLINE ifoldM #-} +ifoldM = G.ifoldM + +-- | /O(n)/ Monadic fold over non-empty vectors +fold1M :: Monad m => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M #-} +fold1M = G.fold1M + +-- | /O(n)/ Monadic fold with strict accumulator +foldM' :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold with strict accumulator (action applied to each +-- element and its index) +ifoldM' :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m a +{-# INLINE ifoldM' #-} +ifoldM' = G.ifoldM' + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +fold1M' :: Monad m => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M' #-} +fold1M' = G.fold1M' + +-- | /O(n)/ Monadic fold that discards the result +foldM_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold that discards the result (action applied to each +-- element and its index) +ifoldM_ :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m () +{-# INLINE ifoldM_ #-} +ifoldM_ = G.ifoldM_ + +-- | /O(n)/ Monadic fold over non-empty vectors that discards the result +fold1M_ :: Monad m => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +foldM'_ :: Monad m => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +-- (action applied to each element and its index) +ifoldM'_ :: Monad m => (a -> Int -> b -> m a) -> a -> Vector b -> m () +{-# INLINE ifoldM'_ #-} +ifoldM'_ = G.ifoldM'_ + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +-- that discards the result +fold1M'_ :: Monad m => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + +-- Monadic sequencing +-- ------------------ + +-- | Evaluate each action and collect the results +sequence :: Monad m => Vector (m a) -> m (Vector a) +{-# INLINE sequence #-} +sequence = G.sequence + +-- | Evaluate each action and discard the results +sequence_ :: Monad m => Vector (m a) -> m () +{-# INLINE sequence_ #-} +sequence_ = G.sequence_ + +-- Prefix sums (scans) +-- ------------------- + +-- | /O(n)/ Prescan +-- +-- @ +-- prescanl f z = 'init' . 'scanl' f z +-- @ +-- +-- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ +-- +prescanl :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl #-} +prescanl = G.prescanl + +-- | /O(n)/ Prescan with strict accumulator +prescanl' :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl' #-} +prescanl' = G.prescanl' + +-- | /O(n)/ Scan +-- +-- @ +-- postscanl f z = 'tail' . 'scanl' f z +-- @ +-- +-- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ +-- +postscanl :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl #-} +postscanl = G.postscanl + +-- | /O(n)/ Scan with strict accumulator +postscanl' :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl' #-} +postscanl' = G.postscanl' + +-- | /O(n)/ Haskell-style scan +-- +-- > scanl f z <x1,...,xn> = <y1,...,y(n+1)> +-- > where y1 = z +-- > yi = f y(i-1) x(i-1) +-- +-- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@ +-- +scanl :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl #-} +scanl = G.scanl + +-- | /O(n)/ Haskell-style scan with strict accumulator +scanl' :: (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl' #-} +scanl' = G.scanl' + +-- | /O(n)/ Scan over a vector with its index +iscanl :: (Int -> a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE iscanl #-} +iscanl = G.iscanl + +-- | /O(n)/ Scan over a vector (strictly) with its index +iscanl' :: (Int -> a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE iscanl' #-} +iscanl' = G.iscanl' + +-- | /O(n)/ Scan over a non-empty vector +-- +-- > scanl f <x1,...,xn> = <y1,...,yn> +-- > where y1 = x1 +-- > yi = f y(i-1) xi +-- +scanl1 :: (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1 #-} +scanl1 = G.scanl1 + +-- | /O(n)/ Scan over a non-empty vector with a strict accumulator +scanl1' :: (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1' #-} +scanl1' = G.scanl1' + +-- | /O(n)/ Right-to-left prescan +-- +-- @ +-- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' +-- @ +-- +prescanr :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr #-} +prescanr = G.prescanr + +-- | /O(n)/ Right-to-left prescan with strict accumulator +prescanr' :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr' #-} +prescanr' = G.prescanr' + +-- | /O(n)/ Right-to-left scan +postscanr :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr #-} +postscanr = G.postscanr + +-- | /O(n)/ Right-to-left scan with strict accumulator +postscanr' :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr' #-} +postscanr' = G.postscanr' + +-- | /O(n)/ Right-to-left Haskell-style scan +scanr :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr #-} +scanr = G.scanr + +-- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator +scanr' :: (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr' #-} +scanr' = G.scanr' + +-- | /O(n)/ Right-to-left scan over a vector with its index +iscanr :: (Int -> a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE iscanr #-} +iscanr = G.iscanr + +-- | /O(n)/ Right-to-left scan over a vector (strictly) with its index +iscanr' :: (Int -> a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE iscanr' #-} +iscanr' = G.iscanr' + +-- | /O(n)/ Right-to-left scan over a non-empty vector +scanr1 :: (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1 #-} +scanr1 = G.scanr1 + +-- | /O(n)/ Right-to-left scan over a non-empty vector with a strict +-- accumulator +scanr1' :: (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1' #-} +scanr1' = G.scanr1' + +-- Conversions - Lists +-- ------------------------ + +-- | /O(n)/ Convert a vector to a list +toList :: Vector a -> [a] +{-# INLINE toList #-} +toList = G.toList + +-- | /O(n)/ Convert a list to a vector +fromList :: [a] -> Vector a +{-# INLINE fromList #-} +fromList = G.fromList + +-- | /O(n)/ Convert the first @n@ elements of a list to a vector +-- +-- @ +-- fromListN n xs = 'fromList' ('take' n xs) +-- @ +fromListN :: Int -> [a] -> Vector a +{-# INLINE fromListN #-} +fromListN = G.fromListN + +-- Conversions - Mutable vectors +-- ----------------------------- + +-- | /O(1)/ Unsafe convert a mutable vector to an immutable one without +-- copying. The mutable vector may not be used after this operation. +unsafeFreeze :: PrimMonad m => MVector (PrimState m) a -> m (Vector a) +{-# INLINE unsafeFreeze #-} +unsafeFreeze = G.unsafeFreeze + +-- | /O(1)/ Unsafely convert an immutable vector to a mutable one without +-- copying. The immutable vector may not be used after this operation. +unsafeThaw :: PrimMonad m => Vector a -> m (MVector (PrimState m) a) +{-# INLINE unsafeThaw #-} +unsafeThaw = G.unsafeThaw + +-- | /O(n)/ Yield a mutable copy of the immutable vector. +thaw :: PrimMonad m => Vector a -> m (MVector (PrimState m) a) +{-# INLINE thaw #-} +thaw = G.thaw + +-- | /O(n)/ Yield an immutable copy of the mutable vector. +freeze :: PrimMonad m => MVector (PrimState m) a -> m (Vector a) +{-# INLINE freeze #-} +freeze = G.freeze + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. This is not checked. +unsafeCopy :: PrimMonad m => MVector (PrimState m) a -> Vector a -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. +copy :: PrimMonad m => MVector (PrimState m) a -> Vector a -> m () +{-# INLINE copy #-} +copy = G.copy diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle.hs new file mode 100644 index 0000000000..6b6b6236d7 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle.hs @@ -0,0 +1,655 @@ +{-# LANGUAGE CPP, FlexibleInstances, Rank2Types, BangPatterns #-} + +-- | +-- Module : Data.Vector.Fusion.Bundle +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Bundles for stream fusion +-- + +module Data.Vector.Fusion.Bundle ( + -- * Types + Step(..), Chunk(..), Bundle, MBundle, + + -- * In-place markers + inplace, + + -- * Size hints + size, sized, + + -- * Length information + length, null, + + -- * Construction + empty, singleton, cons, snoc, replicate, generate, (++), + + -- * Accessing individual elements + head, last, (!!), (!?), + + -- * Substreams + slice, init, tail, take, drop, + + -- * Mapping + map, concatMap, flatten, unbox, + + -- * Zipping + indexed, indexedR, + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + zip, zip3, zip4, zip5, zip6, + + -- * Filtering + filter, takeWhile, dropWhile, + + -- * Searching + elem, notElem, find, findIndex, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, + + -- * Specialised folds + and, or, + + -- * Unfolding + unfoldr, unfoldrN, iterateN, + + -- * Scans + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', + scanl1, scanl1', + + -- * Enumerations + enumFromStepN, enumFromTo, enumFromThenTo, + + -- * Conversions + toList, fromList, fromListN, unsafeFromList, lift, + fromVector, reVector, fromVectors, concatVectors, + + -- * Monadic combinators + mapM, mapM_, zipWithM, zipWithM_, filterM, foldM, fold1M, foldM', fold1M', + + eq, cmp, eqBy, cmpBy +) where + +import Data.Vector.Generic.Base ( Vector ) +import Data.Vector.Fusion.Bundle.Size +import Data.Vector.Fusion.Util +import Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..) ) +import Data.Vector.Fusion.Bundle.Monadic ( Chunk(..) ) +import qualified Data.Vector.Fusion.Bundle.Monadic as M +import qualified Data.Vector.Fusion.Stream.Monadic as S + +import Prelude hiding ( length, null, + replicate, (++), + head, last, (!!), + init, tail, take, drop, + map, concatMap, + zipWith, zipWith3, zip, zip3, + filter, takeWhile, dropWhile, + elem, notElem, + foldl, foldl1, foldr, foldr1, + and, or, + scanl, scanl1, + enumFromTo, enumFromThenTo, + mapM, mapM_ ) + +#if MIN_VERSION_base(4,9,0) +import Data.Functor.Classes (Eq1 (..), Ord1 (..)) +#endif + +import GHC.Base ( build ) + +-- Data.Vector.Internal.Check is unused +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- | The type of pure streams +type Bundle = M.Bundle Id + +-- | Alternative name for monadic streams +type MBundle = M.Bundle + +inplace :: (forall m. Monad m => S.Stream m a -> S.Stream m b) + -> (Size -> Size) -> Bundle v a -> Bundle v b +{-# INLINE_FUSED inplace #-} +inplace f g b = b `seq` M.fromStream (f (M.elements b)) (g (M.size b)) + +{-# RULES + +"inplace/inplace [Vector]" + forall (f1 :: forall m. Monad m => S.Stream m a -> S.Stream m a) + (f2 :: forall m. Monad m => S.Stream m a -> S.Stream m a) + g1 g2 s. + inplace f1 g1 (inplace f2 g2 s) = inplace (f1 . f2) (g1 . g2) s #-} + + + +-- | Convert a pure stream to a monadic stream +lift :: Monad m => Bundle v a -> M.Bundle m v a +{-# INLINE_FUSED lift #-} +lift (M.Bundle (Stream step s) (Stream vstep t) v sz) + = M.Bundle (Stream (return . unId . step) s) + (Stream (return . unId . vstep) t) v sz + +-- | 'Size' hint of a 'Bundle' +size :: Bundle v a -> Size +{-# INLINE size #-} +size = M.size + +-- | Attach a 'Size' hint to a 'Bundle' +sized :: Bundle v a -> Size -> Bundle v a +{-# INLINE sized #-} +sized = M.sized + +-- Length +-- ------ + +-- | Length of a 'Bundle' +length :: Bundle v a -> Int +{-# INLINE length #-} +length = unId . M.length + +-- | Check if a 'Bundle' is empty +null :: Bundle v a -> Bool +{-# INLINE null #-} +null = unId . M.null + +-- Construction +-- ------------ + +-- | Empty 'Bundle' +empty :: Bundle v a +{-# INLINE empty #-} +empty = M.empty + +-- | Singleton 'Bundle' +singleton :: a -> Bundle v a +{-# INLINE singleton #-} +singleton = M.singleton + +-- | Replicate a value to a given length +replicate :: Int -> a -> Bundle v a +{-# INLINE replicate #-} +replicate = M.replicate + +-- | Generate a stream from its indices +generate :: Int -> (Int -> a) -> Bundle v a +{-# INLINE generate #-} +generate = M.generate + +-- | Prepend an element +cons :: a -> Bundle v a -> Bundle v a +{-# INLINE cons #-} +cons = M.cons + +-- | Append an element +snoc :: Bundle v a -> a -> Bundle v a +{-# INLINE snoc #-} +snoc = M.snoc + +infixr 5 ++ +-- | Concatenate two 'Bundle's +(++) :: Bundle v a -> Bundle v a -> Bundle v a +{-# INLINE (++) #-} +(++) = (M.++) + +-- Accessing elements +-- ------------------ + +-- | First element of the 'Bundle' or error if empty +head :: Bundle v a -> a +{-# INLINE head #-} +head = unId . M.head + +-- | Last element of the 'Bundle' or error if empty +last :: Bundle v a -> a +{-# INLINE last #-} +last = unId . M.last + +infixl 9 !! +-- | Element at the given position +(!!) :: Bundle v a -> Int -> a +{-# INLINE (!!) #-} +s !! i = unId (s M.!! i) + +infixl 9 !? +-- | Element at the given position or 'Nothing' if out of bounds +(!?) :: Bundle v a -> Int -> Maybe a +{-# INLINE (!?) #-} +s !? i = unId (s M.!? i) + +-- Substreams +-- ---------- + +-- | Extract a substream of the given length starting at the given position. +slice :: Int -- ^ starting index + -> Int -- ^ length + -> Bundle v a + -> Bundle v a +{-# INLINE slice #-} +slice = M.slice + +-- | All but the last element +init :: Bundle v a -> Bundle v a +{-# INLINE init #-} +init = M.init + +-- | All but the first element +tail :: Bundle v a -> Bundle v a +{-# INLINE tail #-} +tail = M.tail + +-- | The first @n@ elements +take :: Int -> Bundle v a -> Bundle v a +{-# INLINE take #-} +take = M.take + +-- | All but the first @n@ elements +drop :: Int -> Bundle v a -> Bundle v a +{-# INLINE drop #-} +drop = M.drop + +-- Mapping +-- --------------- + +-- | Map a function over a 'Bundle' +map :: (a -> b) -> Bundle v a -> Bundle v b +{-# INLINE map #-} +map = M.map + +unbox :: Bundle v (Box a) -> Bundle v a +{-# INLINE unbox #-} +unbox = M.unbox + +concatMap :: (a -> Bundle v b) -> Bundle v a -> Bundle v b +{-# INLINE concatMap #-} +concatMap = M.concatMap + +-- Zipping +-- ------- + +-- | Pair each element in a 'Bundle' with its index +indexed :: Bundle v a -> Bundle v (Int,a) +{-# INLINE indexed #-} +indexed = M.indexed + +-- | Pair each element in a 'Bundle' with its index, starting from the right +-- and counting down +indexedR :: Int -> Bundle v a -> Bundle v (Int,a) +{-# INLINE_FUSED indexedR #-} +indexedR = M.indexedR + +-- | Zip two 'Bundle's with the given function +zipWith :: (a -> b -> c) -> Bundle v a -> Bundle v b -> Bundle v c +{-# INLINE zipWith #-} +zipWith = M.zipWith + +-- | Zip three 'Bundle's with the given function +zipWith3 :: (a -> b -> c -> d) -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d +{-# INLINE zipWith3 #-} +zipWith3 = M.zipWith3 + +zipWith4 :: (a -> b -> c -> d -> e) + -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d + -> Bundle v e +{-# INLINE zipWith4 #-} +zipWith4 = M.zipWith4 + +zipWith5 :: (a -> b -> c -> d -> e -> f) + -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d + -> Bundle v e -> Bundle v f +{-# INLINE zipWith5 #-} +zipWith5 = M.zipWith5 + +zipWith6 :: (a -> b -> c -> d -> e -> f -> g) + -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d + -> Bundle v e -> Bundle v f -> Bundle v g +{-# INLINE zipWith6 #-} +zipWith6 = M.zipWith6 + +zip :: Bundle v a -> Bundle v b -> Bundle v (a,b) +{-# INLINE zip #-} +zip = M.zip + +zip3 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v (a,b,c) +{-# INLINE zip3 #-} +zip3 = M.zip3 + +zip4 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d + -> Bundle v (a,b,c,d) +{-# INLINE zip4 #-} +zip4 = M.zip4 + +zip5 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d + -> Bundle v e -> Bundle v (a,b,c,d,e) +{-# INLINE zip5 #-} +zip5 = M.zip5 + +zip6 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d + -> Bundle v e -> Bundle v f -> Bundle v (a,b,c,d,e,f) +{-# INLINE zip6 #-} +zip6 = M.zip6 + +-- Filtering +-- --------- + +-- | Drop elements which do not satisfy the predicate +filter :: (a -> Bool) -> Bundle v a -> Bundle v a +{-# INLINE filter #-} +filter = M.filter + +-- | Longest prefix of elements that satisfy the predicate +takeWhile :: (a -> Bool) -> Bundle v a -> Bundle v a +{-# INLINE takeWhile #-} +takeWhile = M.takeWhile + +-- | Drop the longest prefix of elements that satisfy the predicate +dropWhile :: (a -> Bool) -> Bundle v a -> Bundle v a +{-# INLINE dropWhile #-} +dropWhile = M.dropWhile + +-- Searching +-- --------- + +infix 4 `elem` +-- | Check whether the 'Bundle' contains an element +elem :: Eq a => a -> Bundle v a -> Bool +{-# INLINE elem #-} +elem x = unId . M.elem x + +infix 4 `notElem` +-- | Inverse of `elem` +notElem :: Eq a => a -> Bundle v a -> Bool +{-# INLINE notElem #-} +notElem x = unId . M.notElem x + +-- | Yield 'Just' the first element matching the predicate or 'Nothing' if no +-- such element exists. +find :: (a -> Bool) -> Bundle v a -> Maybe a +{-# INLINE find #-} +find f = unId . M.find f + +-- | Yield 'Just' the index of the first element matching the predicate or +-- 'Nothing' if no such element exists. +findIndex :: (a -> Bool) -> Bundle v a -> Maybe Int +{-# INLINE findIndex #-} +findIndex f = unId . M.findIndex f + +-- Folding +-- ------- + +-- | Left fold +foldl :: (a -> b -> a) -> a -> Bundle v b -> a +{-# INLINE foldl #-} +foldl f z = unId . M.foldl f z + +-- | Left fold on non-empty 'Bundle's +foldl1 :: (a -> a -> a) -> Bundle v a -> a +{-# INLINE foldl1 #-} +foldl1 f = unId . M.foldl1 f + +-- | Left fold with strict accumulator +foldl' :: (a -> b -> a) -> a -> Bundle v b -> a +{-# INLINE foldl' #-} +foldl' f z = unId . M.foldl' f z + +-- | Left fold on non-empty 'Bundle's with strict accumulator +foldl1' :: (a -> a -> a) -> Bundle v a -> a +{-# INLINE foldl1' #-} +foldl1' f = unId . M.foldl1' f + +-- | Right fold +foldr :: (a -> b -> b) -> b -> Bundle v a -> b +{-# INLINE foldr #-} +foldr f z = unId . M.foldr f z + +-- | Right fold on non-empty 'Bundle's +foldr1 :: (a -> a -> a) -> Bundle v a -> a +{-# INLINE foldr1 #-} +foldr1 f = unId . M.foldr1 f + +-- Specialised folds +-- ----------------- + +and :: Bundle v Bool -> Bool +{-# INLINE and #-} +and = unId . M.and + +or :: Bundle v Bool -> Bool +{-# INLINE or #-} +or = unId . M.or + +-- Unfolding +-- --------- + +-- | Unfold +unfoldr :: (s -> Maybe (a, s)) -> s -> Bundle v a +{-# INLINE unfoldr #-} +unfoldr = M.unfoldr + +-- | Unfold at most @n@ elements +unfoldrN :: Int -> (s -> Maybe (a, s)) -> s -> Bundle v a +{-# INLINE unfoldrN #-} +unfoldrN = M.unfoldrN + +-- | Apply function n-1 times to value. Zeroth element is original value. +iterateN :: Int -> (a -> a) -> a -> Bundle v a +{-# INLINE iterateN #-} +iterateN = M.iterateN + +-- Scans +-- ----- + +-- | Prefix scan +prescanl :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a +{-# INLINE prescanl #-} +prescanl = M.prescanl + +-- | Prefix scan with strict accumulator +prescanl' :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a +{-# INLINE prescanl' #-} +prescanl' = M.prescanl' + +-- | Suffix scan +postscanl :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a +{-# INLINE postscanl #-} +postscanl = M.postscanl + +-- | Suffix scan with strict accumulator +postscanl' :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a +{-# INLINE postscanl' #-} +postscanl' = M.postscanl' + +-- | Haskell-style scan +scanl :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a +{-# INLINE scanl #-} +scanl = M.scanl + +-- | Haskell-style scan with strict accumulator +scanl' :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a +{-# INLINE scanl' #-} +scanl' = M.scanl' + +-- | Scan over a non-empty 'Bundle' +scanl1 :: (a -> a -> a) -> Bundle v a -> Bundle v a +{-# INLINE scanl1 #-} +scanl1 = M.scanl1 + +-- | Scan over a non-empty 'Bundle' with a strict accumulator +scanl1' :: (a -> a -> a) -> Bundle v a -> Bundle v a +{-# INLINE scanl1' #-} +scanl1' = M.scanl1' + + +-- Comparisons +-- ----------- + +-- | Check if two 'Bundle's are equal +eq :: (Eq a) => Bundle v a -> Bundle v a -> Bool +{-# INLINE eq #-} +eq = eqBy (==) + +eqBy :: (a -> b -> Bool) -> Bundle v a -> Bundle v b -> Bool +{-# INLINE eqBy #-} +eqBy e x y = unId (M.eqBy e x y) + +-- | Lexicographically compare two 'Bundle's +cmp :: (Ord a) => Bundle v a -> Bundle v a -> Ordering +{-# INLINE cmp #-} +cmp = cmpBy compare + +cmpBy :: (a -> b -> Ordering) -> Bundle v a -> Bundle v b -> Ordering +{-# INLINE cmpBy #-} +cmpBy c x y = unId (M.cmpBy c x y) + +instance Eq a => Eq (M.Bundle Id v a) where + {-# INLINE (==) #-} + (==) = eq + +instance Ord a => Ord (M.Bundle Id v a) where + {-# INLINE compare #-} + compare = cmp + +#if MIN_VERSION_base(4,9,0) +instance Eq1 (M.Bundle Id v) where + {-# INLINE liftEq #-} + liftEq = eqBy + +instance Ord1 (M.Bundle Id v) where + {-# INLINE liftCompare #-} + liftCompare = cmpBy +#endif + +-- Monadic combinators +-- ------------------- + +-- | Apply a monadic action to each element of the stream, producing a monadic +-- stream of results +mapM :: Monad m => (a -> m b) -> Bundle v a -> M.Bundle m v b +{-# INLINE mapM #-} +mapM f = M.mapM f . lift + +-- | Apply a monadic action to each element of the stream +mapM_ :: Monad m => (a -> m b) -> Bundle v a -> m () +{-# INLINE mapM_ #-} +mapM_ f = M.mapM_ f . lift + +zipWithM :: Monad m => (a -> b -> m c) -> Bundle v a -> Bundle v b -> M.Bundle m v c +{-# INLINE zipWithM #-} +zipWithM f as bs = M.zipWithM f (lift as) (lift bs) + +zipWithM_ :: Monad m => (a -> b -> m c) -> Bundle v a -> Bundle v b -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ f as bs = M.zipWithM_ f (lift as) (lift bs) + +-- | Yield a monadic stream of elements that satisfy the monadic predicate +filterM :: Monad m => (a -> m Bool) -> Bundle v a -> M.Bundle m v a +{-# INLINE filterM #-} +filterM f = M.filterM f . lift + +-- | Monadic fold +foldM :: Monad m => (a -> b -> m a) -> a -> Bundle v b -> m a +{-# INLINE foldM #-} +foldM m z = M.foldM m z . lift + +-- | Monadic fold over non-empty stream +fold1M :: Monad m => (a -> a -> m a) -> Bundle v a -> m a +{-# INLINE fold1M #-} +fold1M m = M.fold1M m . lift + +-- | Monadic fold with strict accumulator +foldM' :: Monad m => (a -> b -> m a) -> a -> Bundle v b -> m a +{-# INLINE foldM' #-} +foldM' m z = M.foldM' m z . lift + +-- | Monad fold over non-empty stream with strict accumulator +fold1M' :: Monad m => (a -> a -> m a) -> Bundle v a -> m a +{-# INLINE fold1M' #-} +fold1M' m = M.fold1M' m . lift + +-- Enumerations +-- ------------ + +-- | Yield a 'Bundle' of the given length containing the values @x@, @x+y@, +-- @x+y+y@ etc. +enumFromStepN :: Num a => a -> a -> Int -> Bundle v a +{-# INLINE enumFromStepN #-} +enumFromStepN = M.enumFromStepN + +-- | Enumerate values +-- +-- /WARNING:/ This operations can be very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromTo :: Enum a => a -> a -> Bundle v a +{-# INLINE enumFromTo #-} +enumFromTo = M.enumFromTo + +-- | Enumerate values with a given step. +-- +-- /WARNING:/ This operations is very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: Enum a => a -> a -> a -> Bundle v a +{-# INLINE enumFromThenTo #-} +enumFromThenTo = M.enumFromThenTo + +-- Conversions +-- ----------- + +-- | Convert a 'Bundle' to a list +toList :: Bundle v a -> [a] +{-# INLINE toList #-} +-- toList s = unId (M.toList s) +toList s = build (\c n -> toListFB c n s) + +-- This supports foldr/build list fusion that GHC implements +toListFB :: (a -> b -> b) -> b -> Bundle v a -> b +{-# INLINE [0] toListFB #-} +toListFB c n M.Bundle{M.sElems = Stream step t} = go t + where + go s = case unId (step s) of + Yield x s' -> x `c` go s' + Skip s' -> go s' + Done -> n + +-- | Create a 'Bundle' from a list +fromList :: [a] -> Bundle v a +{-# INLINE fromList #-} +fromList = M.fromList + +-- | Create a 'Bundle' from the first @n@ elements of a list +-- +-- > fromListN n xs = fromList (take n xs) +fromListN :: Int -> [a] -> Bundle v a +{-# INLINE fromListN #-} +fromListN = M.fromListN + +unsafeFromList :: Size -> [a] -> Bundle v a +{-# INLINE unsafeFromList #-} +unsafeFromList = M.unsafeFromList + +fromVector :: Vector v a => v a -> Bundle v a +{-# INLINE fromVector #-} +fromVector = M.fromVector + +reVector :: Bundle u a -> Bundle v a +{-# INLINE reVector #-} +reVector = M.reVector + +fromVectors :: Vector v a => [v a] -> Bundle v a +{-# INLINE fromVectors #-} +fromVectors = M.fromVectors + +concatVectors :: Vector v a => Bundle u (v a) -> Bundle v a +{-# INLINE concatVectors #-} +concatVectors = M.concatVectors + +-- | Create a 'Bundle' of values from a 'Bundle' of streamable things +flatten :: (a -> s) -> (s -> Step s b) -> Size -> Bundle v a -> Bundle v b +{-# INLINE_FUSED flatten #-} +flatten mk istep sz = M.flatten (return . mk) (return . istep) sz . lift + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Monadic.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Monadic.hs new file mode 100644 index 0000000000..46f4a165f8 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Monadic.hs @@ -0,0 +1,1106 @@ +{-# LANGUAGE CPP, ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, Rank2Types, BangPatterns, KindSignatures, GADTs, ScopedTypeVariables #-} + +-- | +-- Module : Data.Vector.Fusion.Bundle.Monadic +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Monadic bundles. +-- + +module Data.Vector.Fusion.Bundle.Monadic ( + Bundle(..), Chunk(..), + + -- * Size hints + size, sized, + + -- * Length + length, null, + + -- * Construction + empty, singleton, cons, snoc, replicate, replicateM, generate, generateM, (++), + + -- * Accessing elements + head, last, (!!), (!?), + + -- * Substreams + slice, init, tail, take, drop, + + -- * Mapping + map, mapM, mapM_, trans, unbox, concatMap, flatten, + + -- * Zipping + indexed, indexedR, zipWithM_, + zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M, + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + zip, zip3, zip4, zip5, zip6, + + -- * Comparisons + eqBy, cmpBy, + + -- * Filtering + filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM, + + -- * Searching + elem, notElem, find, findM, findIndex, findIndexM, + + -- * Folding + foldl, foldlM, foldl1, foldl1M, foldM, fold1M, + foldl', foldlM', foldl1', foldl1M', foldM', fold1M', + foldr, foldrM, foldr1, foldr1M, + + -- * Specialised folds + and, or, concatMapM, + + -- * Unfolding + unfoldr, unfoldrM, + unfoldrN, unfoldrNM, + iterateN, iterateNM, + + -- * Scans + prescanl, prescanlM, prescanl', prescanlM', + postscanl, postscanlM, postscanl', postscanlM', + scanl, scanlM, scanl', scanlM', + scanl1, scanl1M, scanl1', scanl1M', + + -- * Enumerations + enumFromStepN, enumFromTo, enumFromThenTo, + + -- * Conversions + toList, fromList, fromListN, unsafeFromList, + fromVector, reVector, fromVectors, concatVectors, + fromStream, chunks, elements +) where + +import Data.Vector.Generic.Base +import qualified Data.Vector.Generic.Mutable.Base as M +import Data.Vector.Fusion.Bundle.Size +import Data.Vector.Fusion.Util ( Box(..), delay_inline ) +import Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..) ) +import qualified Data.Vector.Fusion.Stream.Monadic as S +import Control.Monad.Primitive + +import qualified Data.List as List +import Data.Char ( ord ) +import GHC.Base ( unsafeChr ) +import Control.Monad ( liftM ) +import Prelude hiding ( length, null, + replicate, (++), + head, last, (!!), + init, tail, take, drop, + map, mapM, mapM_, concatMap, + zipWith, zipWith3, zip, zip3, + filter, takeWhile, dropWhile, + elem, notElem, + foldl, foldl1, foldr, foldr1, + and, or, + scanl, scanl1, + enumFromTo, enumFromThenTo ) + +import Data.Int ( Int8, Int16, Int32 ) +import Data.Word ( Word8, Word16, Word32, Word64 ) + +#if !MIN_VERSION_base(4,8,0) +import Data.Word ( Word ) +#endif + +#include "vector.h" +#include "MachDeps.h" + +#if WORD_SIZE_IN_BITS > 32 +import Data.Int ( Int64 ) +#endif + +data Chunk v a = Chunk Int (forall m. (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m ()) + +-- | Monadic streams +data Bundle m v a = Bundle { sElems :: Stream m a + , sChunks :: Stream m (Chunk v a) + , sVector :: Maybe (v a) + , sSize :: Size + } + +fromStream :: Monad m => Stream m a -> Size -> Bundle m v a +{-# INLINE fromStream #-} +fromStream (Stream step t) sz = Bundle (Stream step t) (Stream step' t) Nothing sz + where + step' s = do r <- step s + return $ fmap (\x -> Chunk 1 (\v -> M.basicUnsafeWrite v 0 x)) r + +chunks :: Bundle m v a -> Stream m (Chunk v a) +{-# INLINE chunks #-} +chunks = sChunks + +elements :: Bundle m v a -> Stream m a +{-# INLINE elements #-} +elements = sElems + +-- | 'Size' hint of a 'Bundle' +size :: Bundle m v a -> Size +{-# INLINE size #-} +size = sSize + +-- | Attach a 'Size' hint to a 'Bundle' +sized :: Bundle m v a -> Size -> Bundle m v a +{-# INLINE_FUSED sized #-} +sized s sz = s { sSize = sz } + +-- Length +-- ------ + +-- | Length of a 'Bundle' +length :: Monad m => Bundle m v a -> m Int +{-# INLINE_FUSED length #-} +length Bundle{sSize = Exact n} = return n +length Bundle{sChunks = s} = S.foldl' (\n (Chunk k _) -> n+k) 0 s + +-- | Check if a 'Bundle' is empty +null :: Monad m => Bundle m v a -> m Bool +{-# INLINE_FUSED null #-} +null Bundle{sSize = Exact n} = return (n == 0) +null Bundle{sChunks = s} = S.foldr (\(Chunk n _) z -> n == 0 && z) True s + +-- Construction +-- ------------ + +-- | Empty 'Bundle' +empty :: Monad m => Bundle m v a +{-# INLINE_FUSED empty #-} +empty = fromStream S.empty (Exact 0) + +-- | Singleton 'Bundle' +singleton :: Monad m => a -> Bundle m v a +{-# INLINE_FUSED singleton #-} +singleton x = fromStream (S.singleton x) (Exact 1) + +-- | Replicate a value to a given length +replicate :: Monad m => Int -> a -> Bundle m v a +{-# INLINE_FUSED replicate #-} +replicate n x = Bundle (S.replicate n x) + (S.singleton $ Chunk len (\v -> M.basicSet v x)) + Nothing + (Exact len) + where + len = delay_inline max n 0 + +-- | Yield a 'Bundle' of values obtained by performing the monadic action the +-- given number of times +replicateM :: Monad m => Int -> m a -> Bundle m v a +{-# INLINE_FUSED replicateM #-} +-- NOTE: We delay inlining max here because GHC will create a join point for +-- the call to newArray# otherwise which is not really nice. +replicateM n p = fromStream (S.replicateM n p) (Exact (delay_inline max n 0)) + +generate :: Monad m => Int -> (Int -> a) -> Bundle m v a +{-# INLINE generate #-} +generate n f = generateM n (return . f) + +-- | Generate a stream from its indices +generateM :: Monad m => Int -> (Int -> m a) -> Bundle m v a +{-# INLINE_FUSED generateM #-} +generateM n f = fromStream (S.generateM n f) (Exact (delay_inline max n 0)) + +-- | Prepend an element +cons :: Monad m => a -> Bundle m v a -> Bundle m v a +{-# INLINE cons #-} +cons x s = singleton x ++ s + +-- | Append an element +snoc :: Monad m => Bundle m v a -> a -> Bundle m v a +{-# INLINE snoc #-} +snoc s x = s ++ singleton x + +infixr 5 ++ +-- | Concatenate two 'Bundle's +(++) :: Monad m => Bundle m v a -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED (++) #-} +Bundle sa ta _ na ++ Bundle sb tb _ nb = Bundle (sa S.++ sb) (ta S.++ tb) Nothing (na + nb) + +-- Accessing elements +-- ------------------ + +-- | First element of the 'Bundle' or error if empty +head :: Monad m => Bundle m v a -> m a +{-# INLINE_FUSED head #-} +head = S.head . sElems + +-- | Last element of the 'Bundle' or error if empty +last :: Monad m => Bundle m v a -> m a +{-# INLINE_FUSED last #-} +last = S.last . sElems + +infixl 9 !! +-- | Element at the given position +(!!) :: Monad m => Bundle m v a -> Int -> m a +{-# INLINE (!!) #-} +b !! i = sElems b S.!! i + +infixl 9 !? +-- | Element at the given position or 'Nothing' if out of bounds +(!?) :: Monad m => Bundle m v a -> Int -> m (Maybe a) +{-# INLINE (!?) #-} +b !? i = sElems b S.!? i + +-- Substreams +-- ---------- + +-- | Extract a substream of the given length starting at the given position. +slice :: Monad m => Int -- ^ starting index + -> Int -- ^ length + -> Bundle m v a + -> Bundle m v a +{-# INLINE slice #-} +slice i n s = take n (drop i s) + +-- | All but the last element +init :: Monad m => Bundle m v a -> Bundle m v a +{-# INLINE_FUSED init #-} +init Bundle{sElems = s, sSize = sz} = fromStream (S.init s) (sz-1) + +-- | All but the first element +tail :: Monad m => Bundle m v a -> Bundle m v a +{-# INLINE_FUSED tail #-} +tail Bundle{sElems = s, sSize = sz} = fromStream (S.tail s) (sz-1) + +-- | The first @n@ elements +take :: Monad m => Int -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED take #-} +take n Bundle{sElems = s, sSize = sz} = fromStream (S.take n s) (smaller (Exact n) sz) + +-- | All but the first @n@ elements +drop :: Monad m => Int -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED drop #-} +drop n Bundle{sElems = s, sSize = sz} = + fromStream (S.drop n s) (clampedSubtract sz (Exact n)) + +-- Mapping +-- ------- + +instance Monad m => Functor (Bundle m v) where + {-# INLINE fmap #-} + fmap = map + +-- | Map a function over a 'Bundle' +map :: Monad m => (a -> b) -> Bundle m v a -> Bundle m v b +{-# INLINE map #-} +map f = mapM (return . f) + +-- | Map a monadic function over a 'Bundle' +mapM :: Monad m => (a -> m b) -> Bundle m v a -> Bundle m v b +{-# INLINE_FUSED mapM #-} +mapM f Bundle{sElems = s, sSize = n} = fromStream (S.mapM f s) n + +-- | Execute a monadic action for each element of the 'Bundle' +mapM_ :: Monad m => (a -> m b) -> Bundle m v a -> m () +{-# INLINE_FUSED mapM_ #-} +mapM_ m = S.mapM_ m . sElems + +-- | Transform a 'Bundle' to use a different monad +trans :: (Monad m, Monad m') => (forall z. m z -> m' z) + -> Bundle m v a -> Bundle m' v a +{-# INLINE_FUSED trans #-} +trans f Bundle{sElems = s, sChunks = cs, sVector = v, sSize = n} + = Bundle { sElems = S.trans f s, sChunks = S.trans f cs, sVector = v, sSize = n } + +unbox :: Monad m => Bundle m v (Box a) -> Bundle m v a +{-# INLINE_FUSED unbox #-} +unbox Bundle{sElems = s, sSize = n} = fromStream (S.unbox s) n + +-- Zipping +-- ------- + +-- | Pair each element in a 'Bundle' with its index +indexed :: Monad m => Bundle m v a -> Bundle m v (Int,a) +{-# INLINE_FUSED indexed #-} +indexed Bundle{sElems = s, sSize = n} = fromStream (S.indexed s) n + +-- | Pair each element in a 'Bundle' with its index, starting from the right +-- and counting down +indexedR :: Monad m => Int -> Bundle m v a -> Bundle m v (Int,a) +{-# INLINE_FUSED indexedR #-} +indexedR m Bundle{sElems = s, sSize = n} = fromStream (S.indexedR m s) n + +-- | Zip two 'Bundle's with the given monadic function +zipWithM :: Monad m => (a -> b -> m c) -> Bundle m v a -> Bundle m v b -> Bundle m v c +{-# INLINE_FUSED zipWithM #-} +zipWithM f Bundle{sElems = sa, sSize = na} + Bundle{sElems = sb, sSize = nb} = fromStream (S.zipWithM f sa sb) (smaller na nb) + +-- FIXME: This might expose an opportunity for inplace execution. +{-# RULES + +"zipWithM xs xs [Vector.Bundle]" forall f xs. + zipWithM f xs xs = mapM (\x -> f x x) xs #-} + + +zipWithM_ :: Monad m => (a -> b -> m c) -> Bundle m v a -> Bundle m v b -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ f sa sb = S.zipWithM_ f (sElems sa) (sElems sb) + +zipWith3M :: Monad m => (a -> b -> c -> m d) -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d +{-# INLINE_FUSED zipWith3M #-} +zipWith3M f Bundle{sElems = sa, sSize = na} + Bundle{sElems = sb, sSize = nb} + Bundle{sElems = sc, sSize = nc} + = fromStream (S.zipWith3M f sa sb sc) (smaller na (smaller nb nc)) + +zipWith4M :: Monad m => (a -> b -> c -> d -> m e) + -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e +{-# INLINE zipWith4M #-} +zipWith4M f sa sb sc sd + = zipWithM (\(a,b) (c,d) -> f a b c d) (zip sa sb) (zip sc sd) + +zipWith5M :: Monad m => (a -> b -> c -> d -> e -> m f) + -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e -> Bundle m v f +{-# INLINE zipWith5M #-} +zipWith5M f sa sb sc sd se + = zipWithM (\(a,b,c) (d,e) -> f a b c d e) (zip3 sa sb sc) (zip sd se) + +zipWith6M :: Monad m => (a -> b -> c -> d -> e -> f -> m g) + -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e -> Bundle m v f -> Bundle m v g +{-# INLINE zipWith6M #-} +zipWith6M fn sa sb sc sd se sf + = zipWithM (\(a,b,c) (d,e,f) -> fn a b c d e f) (zip3 sa sb sc) + (zip3 sd se sf) + +zipWith :: Monad m => (a -> b -> c) -> Bundle m v a -> Bundle m v b -> Bundle m v c +{-# INLINE zipWith #-} +zipWith f = zipWithM (\a b -> return (f a b)) + +zipWith3 :: Monad m => (a -> b -> c -> d) + -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d +{-# INLINE zipWith3 #-} +zipWith3 f = zipWith3M (\a b c -> return (f a b c)) + +zipWith4 :: Monad m => (a -> b -> c -> d -> e) + -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e +{-# INLINE zipWith4 #-} +zipWith4 f = zipWith4M (\a b c d -> return (f a b c d)) + +zipWith5 :: Monad m => (a -> b -> c -> d -> e -> f) + -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e -> Bundle m v f +{-# INLINE zipWith5 #-} +zipWith5 f = zipWith5M (\a b c d e -> return (f a b c d e)) + +zipWith6 :: Monad m => (a -> b -> c -> d -> e -> f -> g) + -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e -> Bundle m v f -> Bundle m v g +{-# INLINE zipWith6 #-} +zipWith6 fn = zipWith6M (\a b c d e f -> return (fn a b c d e f)) + +zip :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v (a,b) +{-# INLINE zip #-} +zip = zipWith (,) + +zip3 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v (a,b,c) +{-# INLINE zip3 #-} +zip3 = zipWith3 (,,) + +zip4 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v (a,b,c,d) +{-# INLINE zip4 #-} +zip4 = zipWith4 (,,,) + +zip5 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e -> Bundle m v (a,b,c,d,e) +{-# INLINE zip5 #-} +zip5 = zipWith5 (,,,,) + +zip6 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e -> Bundle m v f -> Bundle m v (a,b,c,d,e,f) +{-# INLINE zip6 #-} +zip6 = zipWith6 (,,,,,) + +-- Comparisons +-- ----------- + +-- | Check if two 'Bundle's are equal +eqBy :: (Monad m) => (a -> b -> Bool) -> Bundle m v a -> Bundle m v b -> m Bool +{-# INLINE_FUSED eqBy #-} +eqBy eq x y = S.eqBy eq (sElems x) (sElems y) + +-- | Lexicographically compare two 'Bundle's +cmpBy :: (Monad m) => (a -> b -> Ordering) -> Bundle m v a -> Bundle m v b -> m Ordering +{-# INLINE_FUSED cmpBy #-} +cmpBy cmp x y = S.cmpBy cmp (sElems x) (sElems y) + +-- Filtering +-- --------- + +-- | Drop elements which do not satisfy the predicate +filter :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a +{-# INLINE filter #-} +filter f = filterM (return . f) + +-- | Drop elements which do not satisfy the monadic predicate +filterM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED filterM #-} +filterM f Bundle{sElems = s, sSize = n} = fromStream (S.filterM f s) (toMax n) + +-- | Longest prefix of elements that satisfy the predicate +takeWhile :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a +{-# INLINE takeWhile #-} +takeWhile f = takeWhileM (return . f) + +-- | Longest prefix of elements that satisfy the monadic predicate +takeWhileM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED takeWhileM #-} +takeWhileM f Bundle{sElems = s, sSize = n} = fromStream (S.takeWhileM f s) (toMax n) + +-- | Drop the longest prefix of elements that satisfy the predicate +dropWhile :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a +{-# INLINE dropWhile #-} +dropWhile f = dropWhileM (return . f) + +-- | Drop the longest prefix of elements that satisfy the monadic predicate +dropWhileM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED dropWhileM #-} +dropWhileM f Bundle{sElems = s, sSize = n} = fromStream (S.dropWhileM f s) (toMax n) + +-- Searching +-- --------- + +infix 4 `elem` +-- | Check whether the 'Bundle' contains an element +elem :: (Monad m, Eq a) => a -> Bundle m v a -> m Bool +{-# INLINE_FUSED elem #-} +elem x = S.elem x . sElems + +infix 4 `notElem` +-- | Inverse of `elem` +notElem :: (Monad m, Eq a) => a -> Bundle m v a -> m Bool +{-# INLINE notElem #-} +notElem x = S.notElem x . sElems + +-- | Yield 'Just' the first element that satisfies the predicate or 'Nothing' +-- if no such element exists. +find :: Monad m => (a -> Bool) -> Bundle m v a -> m (Maybe a) +{-# INLINE find #-} +find f = findM (return . f) + +-- | Yield 'Just' the first element that satisfies the monadic predicate or +-- 'Nothing' if no such element exists. +findM :: Monad m => (a -> m Bool) -> Bundle m v a -> m (Maybe a) +{-# INLINE_FUSED findM #-} +findM f = S.findM f . sElems + +-- | Yield 'Just' the index of the first element that satisfies the predicate +-- or 'Nothing' if no such element exists. +findIndex :: Monad m => (a -> Bool) -> Bundle m v a -> m (Maybe Int) +{-# INLINE_FUSED findIndex #-} +findIndex f = findIndexM (return . f) + +-- | Yield 'Just' the index of the first element that satisfies the monadic +-- predicate or 'Nothing' if no such element exists. +findIndexM :: Monad m => (a -> m Bool) -> Bundle m v a -> m (Maybe Int) +{-# INLINE_FUSED findIndexM #-} +findIndexM f = S.findIndexM f . sElems + +-- Folding +-- ------- + +-- | Left fold +foldl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> m a +{-# INLINE foldl #-} +foldl f = foldlM (\a b -> return (f a b)) + +-- | Left fold with a monadic operator +foldlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a +{-# INLINE_FUSED foldlM #-} +foldlM m z = S.foldlM m z . sElems + +-- | Same as 'foldlM' +foldM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a +{-# INLINE foldM #-} +foldM = foldlM + +-- | Left fold over a non-empty 'Bundle' +foldl1 :: Monad m => (a -> a -> a) -> Bundle m v a -> m a +{-# INLINE foldl1 #-} +foldl1 f = foldl1M (\a b -> return (f a b)) + +-- | Left fold over a non-empty 'Bundle' with a monadic operator +foldl1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a +{-# INLINE_FUSED foldl1M #-} +foldl1M f = S.foldl1M f . sElems + +-- | Same as 'foldl1M' +fold1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a +{-# INLINE fold1M #-} +fold1M = foldl1M + +-- | Left fold with a strict accumulator +foldl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> m a +{-# INLINE foldl' #-} +foldl' f = foldlM' (\a b -> return (f a b)) + +-- | Left fold with a strict accumulator and a monadic operator +foldlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a +{-# INLINE_FUSED foldlM' #-} +foldlM' m z = S.foldlM' m z . sElems + +-- | Same as 'foldlM'' +foldM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a +{-# INLINE foldM' #-} +foldM' = foldlM' + +-- | Left fold over a non-empty 'Bundle' with a strict accumulator +foldl1' :: Monad m => (a -> a -> a) -> Bundle m v a -> m a +{-# INLINE foldl1' #-} +foldl1' f = foldl1M' (\a b -> return (f a b)) + +-- | Left fold over a non-empty 'Bundle' with a strict accumulator and a +-- monadic operator +foldl1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a +{-# INLINE_FUSED foldl1M' #-} +foldl1M' f = S.foldl1M' f . sElems + +-- | Same as 'foldl1M'' +fold1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a +{-# INLINE fold1M' #-} +fold1M' = foldl1M' + +-- | Right fold +foldr :: Monad m => (a -> b -> b) -> b -> Bundle m v a -> m b +{-# INLINE foldr #-} +foldr f = foldrM (\a b -> return (f a b)) + +-- | Right fold with a monadic operator +foldrM :: Monad m => (a -> b -> m b) -> b -> Bundle m v a -> m b +{-# INLINE_FUSED foldrM #-} +foldrM f z = S.foldrM f z . sElems + +-- | Right fold over a non-empty stream +foldr1 :: Monad m => (a -> a -> a) -> Bundle m v a -> m a +{-# INLINE foldr1 #-} +foldr1 f = foldr1M (\a b -> return (f a b)) + +-- | Right fold over a non-empty stream with a monadic operator +foldr1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a +{-# INLINE_FUSED foldr1M #-} +foldr1M f = S.foldr1M f . sElems + +-- Specialised folds +-- ----------------- + +and :: Monad m => Bundle m v Bool -> m Bool +{-# INLINE_FUSED and #-} +and = S.and . sElems + +or :: Monad m => Bundle m v Bool -> m Bool +{-# INLINE_FUSED or #-} +or = S.or . sElems + +concatMap :: Monad m => (a -> Bundle m v b) -> Bundle m v a -> Bundle m v b +{-# INLINE concatMap #-} +concatMap f = concatMapM (return . f) + +concatMapM :: Monad m => (a -> m (Bundle m v b)) -> Bundle m v a -> Bundle m v b +{-# INLINE_FUSED concatMapM #-} +concatMapM f Bundle{sElems = s} = fromStream (S.concatMapM (liftM sElems . f) s) Unknown + +-- | Create a 'Bundle' of values from a 'Bundle' of streamable things +flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Size + -> Bundle m v a -> Bundle m v b +{-# INLINE_FUSED flatten #-} +flatten mk istep sz Bundle{sElems = s} = fromStream (S.flatten mk istep s) sz + +-- Unfolding +-- --------- + +-- | Unfold +unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Bundle m u a +{-# INLINE_FUSED unfoldr #-} +unfoldr f = unfoldrM (return . f) + +-- | Unfold with a monadic function +unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Bundle m u a +{-# INLINE_FUSED unfoldrM #-} +unfoldrM f s = fromStream (S.unfoldrM f s) Unknown + +-- | Unfold at most @n@ elements +unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Bundle m u a +{-# INLINE_FUSED unfoldrN #-} +unfoldrN n f = unfoldrNM n (return . f) + +-- | Unfold at most @n@ elements with a monadic functions +unfoldrNM :: Monad m => Int -> (s -> m (Maybe (a, s))) -> s -> Bundle m u a +{-# INLINE_FUSED unfoldrNM #-} +unfoldrNM n f s = fromStream (S.unfoldrNM n f s) (Max (delay_inline max n 0)) + +-- | Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: Monad m => Int -> (a -> m a) -> a -> Bundle m u a +{-# INLINE_FUSED iterateNM #-} +iterateNM n f x0 = fromStream (S.iterateNM n f x0) (Exact (delay_inline max n 0)) + +-- | Apply function n times to value. Zeroth element is original value. +iterateN :: Monad m => Int -> (a -> a) -> a -> Bundle m u a +{-# INLINE_FUSED iterateN #-} +iterateN n f x0 = iterateNM n (return . f) x0 + +-- Scans +-- ----- + +-- | Prefix scan +prescanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE prescanl #-} +prescanl f = prescanlM (\a b -> return (f a b)) + +-- | Prefix scan with a monadic operator +prescanlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE_FUSED prescanlM #-} +prescanlM f z Bundle{sElems = s, sSize = sz} = fromStream (S.prescanlM f z s) sz + +-- | Prefix scan with strict accumulator +prescanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE prescanl' #-} +prescanl' f = prescanlM' (\a b -> return (f a b)) + +-- | Prefix scan with strict accumulator and a monadic operator +prescanlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE_FUSED prescanlM' #-} +prescanlM' f z Bundle{sElems = s, sSize = sz} = fromStream (S.prescanlM' f z s) sz + +-- | Suffix scan +postscanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE postscanl #-} +postscanl f = postscanlM (\a b -> return (f a b)) + +-- | Suffix scan with a monadic operator +postscanlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE_FUSED postscanlM #-} +postscanlM f z Bundle{sElems = s, sSize = sz} = fromStream (S.postscanlM f z s) sz + +-- | Suffix scan with strict accumulator +postscanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE postscanl' #-} +postscanl' f = postscanlM' (\a b -> return (f a b)) + +-- | Suffix scan with strict acccumulator and a monadic operator +postscanlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE_FUSED postscanlM' #-} +postscanlM' f z Bundle{sElems = s, sSize = sz} = fromStream (S.postscanlM' f z s) sz + +-- | Haskell-style scan +scanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE scanl #-} +scanl f = scanlM (\a b -> return (f a b)) + +-- | Haskell-style scan with a monadic operator +scanlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE scanlM #-} +scanlM f z s = z `cons` postscanlM f z s + +-- | Haskell-style scan with strict accumulator +scanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE scanl' #-} +scanl' f = scanlM' (\a b -> return (f a b)) + +-- | Haskell-style scan with strict accumulator and a monadic operator +scanlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE scanlM' #-} +scanlM' f z s = z `seq` (z `cons` postscanlM f z s) + +-- | Scan over a non-empty 'Bundle' +scanl1 :: Monad m => (a -> a -> a) -> Bundle m v a -> Bundle m v a +{-# INLINE scanl1 #-} +scanl1 f = scanl1M (\x y -> return (f x y)) + +-- | Scan over a non-empty 'Bundle' with a monadic operator +scanl1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED scanl1M #-} +scanl1M f Bundle{sElems = s, sSize = sz} = fromStream (S.scanl1M f s) sz + +-- | Scan over a non-empty 'Bundle' with a strict accumulator +scanl1' :: Monad m => (a -> a -> a) -> Bundle m v a -> Bundle m v a +{-# INLINE scanl1' #-} +scanl1' f = scanl1M' (\x y -> return (f x y)) + +-- | Scan over a non-empty 'Bundle' with a strict accumulator and a monadic +-- operator +scanl1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED scanl1M' #-} +scanl1M' f Bundle{sElems = s, sSize = sz} = fromStream (S.scanl1M' f s) sz + +-- Enumerations +-- ------------ + +-- The Enum class is broken for this, there just doesn't seem to be a +-- way to implement this generically. We have to specialise for as many types +-- as we can but this doesn't help in polymorphic loops. + +-- | Yield a 'Bundle' of the given length containing the values @x@, @x+y@, +-- @x+y+y@ etc. +enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Bundle m v a +{-# INLINE_FUSED enumFromStepN #-} +enumFromStepN x y n = fromStream (S.enumFromStepN x y n) (Exact (delay_inline max n 0)) + +-- | Enumerate values +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromTo :: (Enum a, Monad m) => a -> a -> Bundle m v a +{-# INLINE_FUSED enumFromTo #-} +enumFromTo x y = fromList [x .. y] + +-- NOTE: We use (x+1) instead of (succ x) below because the latter checks for +-- overflow which can't happen here. + +-- FIXME: add "too large" test for Int +enumFromTo_small :: (Integral a, Monad m) => a -> a -> Bundle m v a +{-# INLINE_FUSED enumFromTo_small #-} +enumFromTo_small x y = x `seq` y `seq` fromStream (Stream step x) (Exact n) + where + n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0 + + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Int8> [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Bundle m v Int8 + +"enumFromTo<Int16> [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Bundle m v Int16 + +"enumFromTo<Word8> [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Bundle m v Word8 + +"enumFromTo<Word16> [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Bundle m v Word16 #-} + + + +#if WORD_SIZE_IN_BITS > 32 + +{-# RULES + +"enumFromTo<Int32> [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Bundle m v Int32 + +"enumFromTo<Word32> [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Bundle m v Word32 #-} + +#endif + +-- NOTE: We could implement a generic "too large" test: +-- +-- len x y | x > y = 0 +-- | n > 0 && n <= fromIntegral (maxBound :: Int) = fromIntegral n +-- | otherwise = error +-- where +-- n = y-x+1 +-- +-- Alas, GHC won't eliminate unnecessary comparisons (such as n >= 0 for +-- unsigned types). See http://hackage.haskell.org/trac/ghc/ticket/3744 +-- + +enumFromTo_int :: forall m v. Monad m => Int -> Int -> Bundle m v Int +{-# INLINE_FUSED enumFromTo_int #-} +enumFromTo_int x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y)) + where + {-# INLINE [0] len #-} + len :: Int -> Int -> Int + len u v | u > v = 0 + | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" + (n > 0) + $ n + where + n = v-u+1 + + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +enumFromTo_intlike :: (Integral a, Monad m) => a -> a -> Bundle m v a +{-# INLINE_FUSED enumFromTo_intlike #-} +enumFromTo_intlike x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y)) + where + {-# INLINE [0] len #-} + len u v | u > v = 0 + | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" + (n > 0) + $ fromIntegral n + where + n = v-u+1 + + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Int> [Bundle]" + enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Bundle m v Int + +#if WORD_SIZE_IN_BITS > 32 + +"enumFromTo<Int64> [Bundle]" + enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Bundle m v Int64 #-} + +#else + +"enumFromTo<Int32> [Bundle]" + enumFromTo = enumFromTo_intlike :: Monad m => Int32 -> Int32 -> Bundle m v Int32 #-} + +#endif + + + +enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Bundle m v a +{-# INLINE_FUSED enumFromTo_big_word #-} +enumFromTo_big_word x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y)) + where + {-# INLINE [0] len #-} + len u v | u > v = 0 + | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" + (n < fromIntegral (maxBound :: Int)) + $ fromIntegral (n+1) + where + n = v-u + + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Word> [Bundle]" + enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Bundle m v Word + +"enumFromTo<Word64> [Bundle]" + enumFromTo = enumFromTo_big_word + :: Monad m => Word64 -> Word64 -> Bundle m v Word64 + +#if WORD_SIZE_IN_BITS == 32 + +"enumFromTo<Word32> [Bundle]" + enumFromTo = enumFromTo_big_word + :: Monad m => Word32 -> Word32 -> Bundle m v Word32 + +#endif + +"enumFromTo<Integer> [Bundle]" + enumFromTo = enumFromTo_big_word + :: Monad m => Integer -> Integer -> Bundle m v Integer #-} + + +#if WORD_SIZE_IN_BITS > 32 + +-- FIXME: the "too large" test is totally wrong +enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Bundle m v a +{-# INLINE_FUSED enumFromTo_big_int #-} +enumFromTo_big_int x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y)) + where + {-# INLINE [0] len #-} + len u v | u > v = 0 + | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" + (n > 0 && n <= fromIntegral (maxBound :: Int)) + $ fromIntegral n + where + n = v-u+1 + + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + + +{-# RULES + +"enumFromTo<Int64> [Bundle]" + enumFromTo = enumFromTo_big_int :: Monad m => Int64 -> Int64 -> Bundle m v Int64 #-} + + + +#endif + +enumFromTo_char :: Monad m => Char -> Char -> Bundle m v Char +{-# INLINE_FUSED enumFromTo_char #-} +enumFromTo_char x y = x `seq` y `seq` fromStream (Stream step xn) (Exact n) + where + xn = ord x + yn = ord y + + n = delay_inline max 0 (yn - xn + 1) + + {-# INLINE_INNER step #-} + step zn | zn <= yn = return $ Yield (unsafeChr zn) (zn+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Char> [Bundle]" + enumFromTo = enumFromTo_char #-} + + + +------------------------------------------------------------------------ + +-- Specialise enumFromTo for Float and Double. +-- Also, try to do something about pairs? + +enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Bundle m v a +{-# INLINE_FUSED enumFromTo_double #-} +enumFromTo_double n m = n `seq` m `seq` fromStream (Stream step n) (Max (len n lim)) + where + lim = m + 1/2 -- important to float out + + {-# INLINE [0] len #-} + len x y | x > y = 0 + | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" + (l > 0) + $ fromIntegral l + where + l :: Integer + l = truncate (y-x)+2 + + {-# INLINE_INNER step #-} + step x | x <= lim = return $ Yield x (x+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Double> [Bundle]" + enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Bundle m v Double + +"enumFromTo<Float> [Bundle]" + enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Bundle m v Float #-} + + + +------------------------------------------------------------------------ + +-- | Enumerate values with a given step. +-- +-- /WARNING:/ This operation is very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Enum a, Monad m) => a -> a -> a -> Bundle m v a +{-# INLINE_FUSED enumFromThenTo #-} +enumFromThenTo x y z = fromList [x, y .. z] + +-- FIXME: Specialise enumFromThenTo. + +-- Conversions +-- ----------- + +-- | Convert a 'Bundle' to a list +toList :: Monad m => Bundle m v a -> m [a] +{-# INLINE toList #-} +toList = foldr (:) [] + +-- | Convert a list to a 'Bundle' +fromList :: Monad m => [a] -> Bundle m v a +{-# INLINE fromList #-} +fromList xs = unsafeFromList Unknown xs + +-- | Convert the first @n@ elements of a list to a 'Bundle' +fromListN :: Monad m => Int -> [a] -> Bundle m v a +{-# INLINE_FUSED fromListN #-} +fromListN n xs = fromStream (S.fromListN n xs) (Max (delay_inline max n 0)) + +-- | Convert a list to a 'Bundle' with the given 'Size' hint. +unsafeFromList :: Monad m => Size -> [a] -> Bundle m v a +{-# INLINE_FUSED unsafeFromList #-} +unsafeFromList sz xs = fromStream (S.fromList xs) sz + +fromVector :: (Monad m, Vector v a) => v a -> Bundle m v a +{-# INLINE_FUSED fromVector #-} +fromVector v = v `seq` n `seq` Bundle (Stream step 0) + (Stream vstep True) + (Just v) + (Exact n) + where + n = basicLength v + + {-# INLINE step #-} + step i | i >= n = return Done + | otherwise = case basicUnsafeIndexM v i of + Box x -> return $ Yield x (i+1) + + + {-# INLINE vstep #-} + vstep True = return (Yield (Chunk (basicLength v) (\mv -> basicUnsafeCopy mv v)) False) + vstep False = return Done + +fromVectors :: forall m v a. (Monad m, Vector v a) => [v a] -> Bundle m v a +{-# INLINE_FUSED fromVectors #-} +fromVectors us = Bundle (Stream pstep (Left us)) + (Stream vstep us) + Nothing + (Exact n) + where + n = List.foldl' (\k v -> k + basicLength v) 0 us + + pstep (Left []) = return Done + pstep (Left (v:vs)) = basicLength v `seq` return (Skip (Right (v,0,vs))) + + pstep (Right (v,i,vs)) + | i >= basicLength v = return $ Skip (Left vs) + | otherwise = case basicUnsafeIndexM v i of + Box x -> return $ Yield x (Right (v,i+1,vs)) + + -- FIXME: work around bug in GHC 7.6.1 + vstep :: [v a] -> m (Step [v a] (Chunk v a)) + vstep [] = return Done + vstep (v:vs) = return $ Yield (Chunk (basicLength v) + (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch" + (M.basicLength mv == basicLength v) + $ basicUnsafeCopy mv v)) vs + + +concatVectors :: (Monad m, Vector v a) => Bundle m u (v a) -> Bundle m v a +{-# INLINE_FUSED concatVectors #-} +concatVectors Bundle{sElems = Stream step t} + = Bundle (Stream pstep (Left t)) + (Stream vstep t) + Nothing + Unknown + where + pstep (Left s) = do + r <- step s + case r of + Yield v s' -> basicLength v `seq` return (Skip (Right (v,0,s'))) + Skip s' -> return (Skip (Left s')) + Done -> return Done + + pstep (Right (v,i,s)) + | i >= basicLength v = return (Skip (Left s)) + | otherwise = case basicUnsafeIndexM v i of + Box x -> return (Yield x (Right (v,i+1,s))) + + + vstep s = do + r <- step s + case r of + Yield v s' -> return (Yield (Chunk (basicLength v) + (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch" + (M.basicLength mv == basicLength v) + $ basicUnsafeCopy mv v)) s') + Skip s' -> return (Skip s') + Done -> return Done + +reVector :: Monad m => Bundle m u a -> Bundle m v a +{-# INLINE_FUSED reVector #-} +reVector Bundle{sElems = s, sSize = n} = fromStream s n + +{-# RULES + +"reVector [Vector]" + reVector = id + +"reVector/reVector [Vector]" forall s. + reVector (reVector s) = s #-} + + + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Size.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Size.hs new file mode 100644 index 0000000000..e90cf37320 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Size.hs @@ -0,0 +1,121 @@ +-- | +-- Module : Data.Vector.Fusion.Bundle.Size +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : portable +-- +-- Size hints for streams. +-- + +module Data.Vector.Fusion.Bundle.Size ( + Size(..), clampedSubtract, smaller, larger, toMax, upperBound, lowerBound +) where + +import Data.Vector.Fusion.Util ( delay_inline ) + +-- | Size hint +data Size = Exact Int -- ^ Exact size + | Max Int -- ^ Upper bound on the size + | Unknown -- ^ Unknown size + deriving( Eq, Show ) + +instance Num Size where + Exact m + Exact n = checkedAdd Exact m n + Exact m + Max n = checkedAdd Max m n + + Max m + Exact n = checkedAdd Max m n + Max m + Max n = checkedAdd Max m n + + _ + _ = Unknown + + + Exact m - Exact n = checkedSubtract Exact m n + Exact m - Max _ = Max m + + Max m - Exact n = checkedSubtract Max m n + Max m - Max _ = Max m + Max m - Unknown = Max m + + _ - _ = Unknown + + + fromInteger n = Exact (fromInteger n) + + (*) = error "vector: internal error * for Bundle.size isn't defined" + abs = error "vector: internal error abs for Bundle.size isn't defined" + signum = error "vector: internal error signum for Bundle.size isn't defined" + +{-# INLINE checkedAdd #-} +checkedAdd :: (Int -> Size) -> Int -> Int -> Size +checkedAdd con m n + -- Note: we assume m and n are >= 0. + | r < m || r < n = + error $ "Data.Vector.Fusion.Bundle.Size.checkedAdd: overflow: " ++ show r + | otherwise = con r + where + r = m + n + +{-# INLINE checkedSubtract #-} +checkedSubtract :: (Int -> Size) -> Int -> Int -> Size +checkedSubtract con m n + | r < 0 = + error $ "Data.Vector.Fusion.Bundle.Size.checkedSubtract: underflow: " ++ show r + | otherwise = con r + where + r = m - n + +-- | Subtract two sizes with clamping to 0, for drop-like things +{-# INLINE clampedSubtract #-} +clampedSubtract :: Size -> Size -> Size +clampedSubtract (Exact m) (Exact n) = Exact (max 0 (m - n)) +clampedSubtract (Max m) (Exact n) + | m <= n = Exact 0 + | otherwise = Max (m - n) +clampedSubtract (Exact m) (Max _) = Max m +clampedSubtract (Max m) (Max _) = Max m +clampedSubtract _ _ = Unknown + +-- | Minimum of two size hints +smaller :: Size -> Size -> Size +{-# INLINE smaller #-} +smaller (Exact m) (Exact n) = Exact (delay_inline min m n) +smaller (Exact m) (Max n) = Max (delay_inline min m n) +smaller (Exact m) Unknown = Max m +smaller (Max m) (Exact n) = Max (delay_inline min m n) +smaller (Max m) (Max n) = Max (delay_inline min m n) +smaller (Max m) Unknown = Max m +smaller Unknown (Exact n) = Max n +smaller Unknown (Max n) = Max n +smaller Unknown Unknown = Unknown + +-- | Maximum of two size hints +larger :: Size -> Size -> Size +{-# INLINE larger #-} +larger (Exact m) (Exact n) = Exact (delay_inline max m n) +larger (Exact m) (Max n) | m >= n = Exact m + | otherwise = Max n +larger (Max m) (Exact n) | n >= m = Exact n + | otherwise = Max m +larger (Max m) (Max n) = Max (delay_inline max m n) +larger _ _ = Unknown + +-- | Convert a size hint to an upper bound +toMax :: Size -> Size +toMax (Exact n) = Max n +toMax (Max n) = Max n +toMax Unknown = Unknown + +-- | Compute the minimum size from a size hint +lowerBound :: Size -> Int +lowerBound (Exact n) = n +lowerBound _ = 0 + +-- | Compute the maximum size from a size hint if possible +upperBound :: Size -> Maybe Int +upperBound (Exact n) = Just n +upperBound (Max n) = Just n +upperBound Unknown = Nothing + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Stream/Monadic.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Stream/Monadic.hs new file mode 100644 index 0000000000..cca002ca6f --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Stream/Monadic.hs @@ -0,0 +1,1639 @@ +{-# LANGUAGE CPP, ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, Rank2Types, BangPatterns, KindSignatures, GADTs, ScopedTypeVariables #-} + +-- | +-- Module : Data.Vector.Fusion.Stream.Monadic +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Monadic stream combinators. +-- + +module Data.Vector.Fusion.Stream.Monadic ( + Stream(..), Step(..), SPEC(..), + + -- * Length + length, null, + + -- * Construction + empty, singleton, cons, snoc, replicate, replicateM, generate, generateM, (++), + + -- * Accessing elements + head, last, (!!), (!?), + + -- * Substreams + slice, init, tail, take, drop, + + -- * Mapping + map, mapM, mapM_, trans, unbox, concatMap, flatten, + + -- * Zipping + indexed, indexedR, zipWithM_, + zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M, + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + zip, zip3, zip4, zip5, zip6, + + -- * Comparisons + eqBy, cmpBy, + + -- * Filtering + filter, filterM, uniq, mapMaybe, takeWhile, takeWhileM, dropWhile, dropWhileM, + + -- * Searching + elem, notElem, find, findM, findIndex, findIndexM, + + -- * Folding + foldl, foldlM, foldl1, foldl1M, foldM, fold1M, + foldl', foldlM', foldl1', foldl1M', foldM', fold1M', + foldr, foldrM, foldr1, foldr1M, + + -- * Specialised folds + and, or, concatMapM, + + -- * Unfolding + unfoldr, unfoldrM, + unfoldrN, unfoldrNM, + iterateN, iterateNM, + + -- * Scans + prescanl, prescanlM, prescanl', prescanlM', + postscanl, postscanlM, postscanl', postscanlM', + scanl, scanlM, scanl', scanlM', + scanl1, scanl1M, scanl1', scanl1M', + + -- * Enumerations + enumFromStepN, enumFromTo, enumFromThenTo, + + -- * Conversions + toList, fromList, fromListN +) where + +import Data.Vector.Fusion.Util ( Box(..) ) + +import Data.Char ( ord ) +import GHC.Base ( unsafeChr ) +import Control.Monad ( liftM ) +import Prelude hiding ( length, null, + replicate, (++), + head, last, (!!), + init, tail, take, drop, + map, mapM, mapM_, concatMap, + zipWith, zipWith3, zip, zip3, + filter, takeWhile, dropWhile, + elem, notElem, + foldl, foldl1, foldr, foldr1, + and, or, + scanl, scanl1, + enumFromTo, enumFromThenTo ) + +import Data.Int ( Int8, Int16, Int32 ) +import Data.Word ( Word8, Word16, Word32, Word64 ) + +#if !MIN_VERSION_base(4,8,0) +import Data.Word ( Word8, Word16, Word32, Word, Word64 ) +#endif + +#if __GLASGOW_HASKELL__ >= 708 +import GHC.Types ( SPEC(..) ) +#elif __GLASGOW_HASKELL__ >= 700 +import GHC.Exts ( SpecConstrAnnotation(..) ) +#endif + +#include "vector.h" +#include "MachDeps.h" + +#if WORD_SIZE_IN_BITS > 32 +import Data.Int ( Int64 ) +#endif + +#if __GLASGOW_HASKELL__ < 708 +data SPEC = SPEC | SPEC2 +#if __GLASGOW_HASKELL__ >= 700 +{-# ANN type SPEC ForceSpecConstr #-} +#endif +#endif + +emptyStream :: String +{-# NOINLINE emptyStream #-} +emptyStream = "empty stream" + +#define EMPTY_STREAM (\state -> ERROR state emptyStream) + +-- | Result of taking a single step in a stream +data Step s a where + Yield :: a -> s -> Step s a + Skip :: s -> Step s a + Done :: Step s a + +instance Functor (Step s) where + {-# INLINE fmap #-} + fmap f (Yield x s) = Yield (f x) s + fmap _ (Skip s) = Skip s + fmap _ Done = Done + +-- | Monadic streams +data Stream m a = forall s. Stream (s -> m (Step s a)) s + +-- Length +-- ------ + +-- | Length of a 'Stream' +length :: Monad m => Stream m a -> m Int +{-# INLINE_FUSED length #-} +length = foldl' (\n _ -> n+1) 0 + +-- | Check if a 'Stream' is empty +null :: Monad m => Stream m a -> m Bool +{-# INLINE_FUSED null #-} +null (Stream step t) = null_loop t + where + null_loop s = do + r <- step s + case r of + Yield _ _ -> return False + Skip s' -> null_loop s' + Done -> return True + +-- Construction +-- ------------ + +-- | Empty 'Stream' +empty :: Monad m => Stream m a +{-# INLINE_FUSED empty #-} +empty = Stream (const (return Done)) () + +-- | Singleton 'Stream' +singleton :: Monad m => a -> Stream m a +{-# INLINE_FUSED singleton #-} +singleton x = Stream (return . step) True + where + {-# INLINE_INNER step #-} + step True = Yield x False + step False = Done + +-- | Replicate a value to a given length +replicate :: Monad m => Int -> a -> Stream m a +{-# INLINE_FUSED replicate #-} +replicate n x = replicateM n (return x) + +-- | Yield a 'Stream' of values obtained by performing the monadic action the +-- given number of times +replicateM :: Monad m => Int -> m a -> Stream m a +{-# INLINE_FUSED replicateM #-} +replicateM n p = Stream step n + where + {-# INLINE_INNER step #-} + step i | i <= 0 = return Done + | otherwise = do { x <- p; return $ Yield x (i-1) } + +generate :: Monad m => Int -> (Int -> a) -> Stream m a +{-# INLINE generate #-} +generate n f = generateM n (return . f) + +-- | Generate a stream from its indices +generateM :: Monad m => Int -> (Int -> m a) -> Stream m a +{-# INLINE_FUSED generateM #-} +generateM n f = n `seq` Stream step 0 + where + {-# INLINE_INNER step #-} + step i | i < n = do + x <- f i + return $ Yield x (i+1) + | otherwise = return Done + +-- | Prepend an element +cons :: Monad m => a -> Stream m a -> Stream m a +{-# INLINE cons #-} +cons x s = singleton x ++ s + +-- | Append an element +snoc :: Monad m => Stream m a -> a -> Stream m a +{-# INLINE snoc #-} +snoc s x = s ++ singleton x + +infixr 5 ++ +-- | Concatenate two 'Stream's +(++) :: Monad m => Stream m a -> Stream m a -> Stream m a +{-# INLINE_FUSED (++) #-} +Stream stepa ta ++ Stream stepb tb = Stream step (Left ta) + where + {-# INLINE_INNER step #-} + step (Left sa) = do + r <- stepa sa + case r of + Yield x sa' -> return $ Yield x (Left sa') + Skip sa' -> return $ Skip (Left sa') + Done -> return $ Skip (Right tb) + step (Right sb) = do + r <- stepb sb + case r of + Yield x sb' -> return $ Yield x (Right sb') + Skip sb' -> return $ Skip (Right sb') + Done -> return $ Done + +-- Accessing elements +-- ------------------ + +-- | First element of the 'Stream' or error if empty +head :: Monad m => Stream m a -> m a +{-# INLINE_FUSED head #-} +head (Stream step t) = head_loop SPEC t + where + head_loop !_ s + = do + r <- step s + case r of + Yield x _ -> return x + Skip s' -> head_loop SPEC s' + Done -> EMPTY_STREAM "head" + + + +-- | Last element of the 'Stream' or error if empty +last :: Monad m => Stream m a -> m a +{-# INLINE_FUSED last #-} +last (Stream step t) = last_loop0 SPEC t + where + last_loop0 !_ s + = do + r <- step s + case r of + Yield x s' -> last_loop1 SPEC x s' + Skip s' -> last_loop0 SPEC s' + Done -> EMPTY_STREAM "last" + + last_loop1 !_ x s + = do + r <- step s + case r of + Yield y s' -> last_loop1 SPEC y s' + Skip s' -> last_loop1 SPEC x s' + Done -> return x + +infixl 9 !! +-- | Element at the given position +(!!) :: Monad m => Stream m a -> Int -> m a +{-# INLINE (!!) #-} +Stream step t !! j | j < 0 = ERROR "!!" "negative index" + | otherwise = index_loop SPEC t j + where + index_loop !_ s i + = i `seq` + do + r <- step s + case r of + Yield x s' | i == 0 -> return x + | otherwise -> index_loop SPEC s' (i-1) + Skip s' -> index_loop SPEC s' i + Done -> EMPTY_STREAM "!!" + +infixl 9 !? +-- | Element at the given position or 'Nothing' if out of bounds +(!?) :: Monad m => Stream m a -> Int -> m (Maybe a) +{-# INLINE (!?) #-} +Stream step t !? j = index_loop SPEC t j + where + index_loop !_ s i + = i `seq` + do + r <- step s + case r of + Yield x s' | i == 0 -> return (Just x) + | otherwise -> index_loop SPEC s' (i-1) + Skip s' -> index_loop SPEC s' i + Done -> return Nothing + +-- Substreams +-- ---------- + +-- | Extract a substream of the given length starting at the given position. +slice :: Monad m => Int -- ^ starting index + -> Int -- ^ length + -> Stream m a + -> Stream m a +{-# INLINE slice #-} +slice i n s = take n (drop i s) + +-- | All but the last element +init :: Monad m => Stream m a -> Stream m a +{-# INLINE_FUSED init #-} +init (Stream step t) = Stream step' (Nothing, t) + where + {-# INLINE_INNER step' #-} + step' (Nothing, s) = liftM (\r -> + case r of + Yield x s' -> Skip (Just x, s') + Skip s' -> Skip (Nothing, s') + Done -> EMPTY_STREAM "init" + ) (step s) + + step' (Just x, s) = liftM (\r -> + case r of + Yield y s' -> Yield x (Just y, s') + Skip s' -> Skip (Just x, s') + Done -> Done + ) (step s) + +-- | All but the first element +tail :: Monad m => Stream m a -> Stream m a +{-# INLINE_FUSED tail #-} +tail (Stream step t) = Stream step' (Left t) + where + {-# INLINE_INNER step' #-} + step' (Left s) = liftM (\r -> + case r of + Yield _ s' -> Skip (Right s') + Skip s' -> Skip (Left s') + Done -> EMPTY_STREAM "tail" + ) (step s) + + step' (Right s) = liftM (\r -> + case r of + Yield x s' -> Yield x (Right s') + Skip s' -> Skip (Right s') + Done -> Done + ) (step s) + +-- | The first @n@ elements +take :: Monad m => Int -> Stream m a -> Stream m a +{-# INLINE_FUSED take #-} +take n (Stream step t) = n `seq` Stream step' (t, 0) + where + {-# INLINE_INNER step' #-} + step' (s, i) | i < n = liftM (\r -> + case r of + Yield x s' -> Yield x (s', i+1) + Skip s' -> Skip (s', i) + Done -> Done + ) (step s) + step' (_, _) = return Done + +-- | All but the first @n@ elements +drop :: Monad m => Int -> Stream m a -> Stream m a +{-# INLINE_FUSED drop #-} +drop n (Stream step t) = Stream step' (t, Just n) + where + {-# INLINE_INNER step' #-} + step' (s, Just i) | i > 0 = liftM (\r -> + case r of + Yield _ s' -> Skip (s', Just (i-1)) + Skip s' -> Skip (s', Just i) + Done -> Done + ) (step s) + | otherwise = return $ Skip (s, Nothing) + + step' (s, Nothing) = liftM (\r -> + case r of + Yield x s' -> Yield x (s', Nothing) + Skip s' -> Skip (s', Nothing) + Done -> Done + ) (step s) + +-- Mapping +-- ------- + +instance Monad m => Functor (Stream m) where + {-# INLINE fmap #-} + fmap = map + +-- | Map a function over a 'Stream' +map :: Monad m => (a -> b) -> Stream m a -> Stream m b +{-# INLINE map #-} +map f = mapM (return . f) + + +-- | Map a monadic function over a 'Stream' +mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b +{-# INLINE_FUSED mapM #-} +mapM f (Stream step t) = Stream step' t + where + {-# INLINE_INNER step' #-} + step' s = do + r <- step s + case r of + Yield x s' -> liftM (`Yield` s') (f x) + Skip s' -> return (Skip s') + Done -> return Done + +consume :: Monad m => Stream m a -> m () +{-# INLINE_FUSED consume #-} +consume (Stream step t) = consume_loop SPEC t + where + consume_loop !_ s + = do + r <- step s + case r of + Yield _ s' -> consume_loop SPEC s' + Skip s' -> consume_loop SPEC s' + Done -> return () + +-- | Execute a monadic action for each element of the 'Stream' +mapM_ :: Monad m => (a -> m b) -> Stream m a -> m () +{-# INLINE_FUSED mapM_ #-} +mapM_ m = consume . mapM m + +-- | Transform a 'Stream' to use a different monad +trans :: (Monad m, Monad m') + => (forall z. m z -> m' z) -> Stream m a -> Stream m' a +{-# INLINE_FUSED trans #-} +trans f (Stream step s) = Stream (f . step) s + +unbox :: Monad m => Stream m (Box a) -> Stream m a +{-# INLINE_FUSED unbox #-} +unbox (Stream step t) = Stream step' t + where + {-# INLINE_INNER step' #-} + step' s = do + r <- step s + case r of + Yield (Box x) s' -> return $ Yield x s' + Skip s' -> return $ Skip s' + Done -> return $ Done + +-- Zipping +-- ------- + +-- | Pair each element in a 'Stream' with its index +indexed :: Monad m => Stream m a -> Stream m (Int,a) +{-# INLINE_FUSED indexed #-} +indexed (Stream step t) = Stream step' (t,0) + where + {-# INLINE_INNER step' #-} + step' (s,i) = i `seq` + do + r <- step s + case r of + Yield x s' -> return $ Yield (i,x) (s', i+1) + Skip s' -> return $ Skip (s', i) + Done -> return Done + +-- | Pair each element in a 'Stream' with its index, starting from the right +-- and counting down +indexedR :: Monad m => Int -> Stream m a -> Stream m (Int,a) +{-# INLINE_FUSED indexedR #-} +indexedR m (Stream step t) = Stream step' (t,m) + where + {-# INLINE_INNER step' #-} + step' (s,i) = i `seq` + do + r <- step s + case r of + Yield x s' -> let i' = i-1 + in + return $ Yield (i',x) (s', i') + Skip s' -> return $ Skip (s', i) + Done -> return Done + +-- | Zip two 'Stream's with the given monadic function +zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c +{-# INLINE_FUSED zipWithM #-} +zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing) + where + {-# INLINE_INNER step #-} + step (sa, sb, Nothing) = liftM (\r -> + case r of + Yield x sa' -> Skip (sa', sb, Just x) + Skip sa' -> Skip (sa', sb, Nothing) + Done -> Done + ) (stepa sa) + + step (sa, sb, Just x) = do + r <- stepb sb + case r of + Yield y sb' -> + do + z <- f x y + return $ Yield z (sa, sb', Nothing) + Skip sb' -> return $ Skip (sa, sb', Just x) + Done -> return $ Done + +-- FIXME: This might expose an opportunity for inplace execution. +{-# RULES + +"zipWithM xs xs [Vector.Stream]" forall f xs. + zipWithM f xs xs = mapM (\x -> f x x) xs #-} + + +zipWithM_ :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ f sa sb = consume (zipWithM f sa sb) + +zipWith3M :: Monad m => (a -> b -> c -> m d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d +{-# INLINE_FUSED zipWith3M #-} +zipWith3M f (Stream stepa ta) + (Stream stepb tb) + (Stream stepc tc) = Stream step (ta, tb, tc, Nothing) + where + {-# INLINE_INNER step #-} + step (sa, sb, sc, Nothing) = do + r <- stepa sa + return $ case r of + Yield x sa' -> Skip (sa', sb, sc, Just (x, Nothing)) + Skip sa' -> Skip (sa', sb, sc, Nothing) + Done -> Done + + step (sa, sb, sc, Just (x, Nothing)) = do + r <- stepb sb + return $ case r of + Yield y sb' -> Skip (sa, sb', sc, Just (x, Just y)) + Skip sb' -> Skip (sa, sb', sc, Just (x, Nothing)) + Done -> Done + + step (sa, sb, sc, Just (x, Just y)) = do + r <- stepc sc + case r of + Yield z sc' -> f x y z >>= (\res -> return $ Yield res (sa, sb, sc', Nothing)) + Skip sc' -> return $ Skip (sa, sb, sc', Just (x, Just y)) + Done -> return $ Done + +zipWith4M :: Monad m => (a -> b -> c -> d -> m e) + -> Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e +{-# INLINE zipWith4M #-} +zipWith4M f sa sb sc sd + = zipWithM (\(a,b) (c,d) -> f a b c d) (zip sa sb) (zip sc sd) + +zipWith5M :: Monad m => (a -> b -> c -> d -> e -> m f) + -> Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e -> Stream m f +{-# INLINE zipWith5M #-} +zipWith5M f sa sb sc sd se + = zipWithM (\(a,b,c) (d,e) -> f a b c d e) (zip3 sa sb sc) (zip sd se) + +zipWith6M :: Monad m => (a -> b -> c -> d -> e -> f -> m g) + -> Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e -> Stream m f -> Stream m g +{-# INLINE zipWith6M #-} +zipWith6M fn sa sb sc sd se sf + = zipWithM (\(a,b,c) (d,e,f) -> fn a b c d e f) (zip3 sa sb sc) + (zip3 sd se sf) + +zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c +{-# INLINE zipWith #-} +zipWith f = zipWithM (\a b -> return (f a b)) + +zipWith3 :: Monad m => (a -> b -> c -> d) + -> Stream m a -> Stream m b -> Stream m c -> Stream m d +{-# INLINE zipWith3 #-} +zipWith3 f = zipWith3M (\a b c -> return (f a b c)) + +zipWith4 :: Monad m => (a -> b -> c -> d -> e) + -> Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e +{-# INLINE zipWith4 #-} +zipWith4 f = zipWith4M (\a b c d -> return (f a b c d)) + +zipWith5 :: Monad m => (a -> b -> c -> d -> e -> f) + -> Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e -> Stream m f +{-# INLINE zipWith5 #-} +zipWith5 f = zipWith5M (\a b c d e -> return (f a b c d e)) + +zipWith6 :: Monad m => (a -> b -> c -> d -> e -> f -> g) + -> Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e -> Stream m f -> Stream m g +{-# INLINE zipWith6 #-} +zipWith6 fn = zipWith6M (\a b c d e f -> return (fn a b c d e f)) + +zip :: Monad m => Stream m a -> Stream m b -> Stream m (a,b) +{-# INLINE zip #-} +zip = zipWith (,) + +zip3 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m (a,b,c) +{-# INLINE zip3 #-} +zip3 = zipWith3 (,,) + +zip4 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m (a,b,c,d) +{-# INLINE zip4 #-} +zip4 = zipWith4 (,,,) + +zip5 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e -> Stream m (a,b,c,d,e) +{-# INLINE zip5 #-} +zip5 = zipWith5 (,,,,) + +zip6 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e -> Stream m f -> Stream m (a,b,c,d,e,f) +{-# INLINE zip6 #-} +zip6 = zipWith6 (,,,,,) + +-- Comparisons +-- ----------- + +-- | Check if two 'Stream's are equal +eqBy :: (Monad m) => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool +{-# INLINE_FUSED eqBy #-} +eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2 + where + eq_loop0 !_ s1 s2 = do + r <- step1 s1 + case r of + Yield x s1' -> eq_loop1 SPEC x s1' s2 + Skip s1' -> eq_loop0 SPEC s1' s2 + Done -> eq_null s2 + + eq_loop1 !_ x s1 s2 = do + r <- step2 s2 + case r of + Yield y s2' + | eq x y -> eq_loop0 SPEC s1 s2' + | otherwise -> return False + Skip s2' -> eq_loop1 SPEC x s1 s2' + Done -> return False + + eq_null s2 = do + r <- step2 s2 + case r of + Yield _ _ -> return False + Skip s2' -> eq_null s2' + Done -> return True + +-- | Lexicographically compare two 'Stream's +cmpBy :: (Monad m) => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering +{-# INLINE_FUSED cmpBy #-} +cmpBy cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2 + where + cmp_loop0 !_ s1 s2 = do + r <- step1 s1 + case r of + Yield x s1' -> cmp_loop1 SPEC x s1' s2 + Skip s1' -> cmp_loop0 SPEC s1' s2 + Done -> cmp_null s2 + + cmp_loop1 !_ x s1 s2 = do + r <- step2 s2 + case r of + Yield y s2' -> case x `cmp` y of + EQ -> cmp_loop0 SPEC s1 s2' + c -> return c + Skip s2' -> cmp_loop1 SPEC x s1 s2' + Done -> return GT + + cmp_null s2 = do + r <- step2 s2 + case r of + Yield _ _ -> return LT + Skip s2' -> cmp_null s2' + Done -> return EQ + +-- Filtering +-- --------- + +-- | Drop elements which do not satisfy the predicate +filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a +{-# INLINE filter #-} +filter f = filterM (return . f) + +mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b +{-# INLINE_FUSED mapMaybe #-} +mapMaybe f (Stream step t) = Stream step' t + where + {-# INLINE_INNER step' #-} + step' s = do + r <- step s + case r of + Yield x s' -> do + return $ case f x of + Nothing -> Skip s' + Just b' -> Yield b' s' + Skip s' -> return $ Skip s' + Done -> return $ Done + +-- | Drop elements which do not satisfy the monadic predicate +filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a +{-# INLINE_FUSED filterM #-} +filterM f (Stream step t) = Stream step' t + where + {-# INLINE_INNER step' #-} + step' s = do + r <- step s + case r of + Yield x s' -> do + b <- f x + return $ if b then Yield x s' + else Skip s' + Skip s' -> return $ Skip s' + Done -> return $ Done + +-- | Drop repeated adjacent elements. +uniq :: (Eq a, Monad m) => Stream m a -> Stream m a +{-# INLINE_FUSED uniq #-} +uniq (Stream step st) = Stream step' (Nothing,st) + where + {-# INLINE_INNER step' #-} + step' (Nothing, s) = do r <- step s + case r of + Yield x s' -> return $ Yield x (Just x , s') + Skip s' -> return $ Skip (Nothing, s') + Done -> return Done + step' (Just x0, s) = do r <- step s + case r of + Yield x s' | x == x0 -> return $ Skip (Just x0, s') + | otherwise -> return $ Yield x (Just x , s') + Skip s' -> return $ Skip (Just x0, s') + Done -> return Done + +-- | Longest prefix of elements that satisfy the predicate +takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a +{-# INLINE takeWhile #-} +takeWhile f = takeWhileM (return . f) + +-- | Longest prefix of elements that satisfy the monadic predicate +takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a +{-# INLINE_FUSED takeWhileM #-} +takeWhileM f (Stream step t) = Stream step' t + where + {-# INLINE_INNER step' #-} + step' s = do + r <- step s + case r of + Yield x s' -> do + b <- f x + return $ if b then Yield x s' else Done + Skip s' -> return $ Skip s' + Done -> return $ Done + +-- | Drop the longest prefix of elements that satisfy the predicate +dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a +{-# INLINE dropWhile #-} +dropWhile f = dropWhileM (return . f) + +data DropWhile s a = DropWhile_Drop s | DropWhile_Yield a s | DropWhile_Next s + +-- | Drop the longest prefix of elements that satisfy the monadic predicate +dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a +{-# INLINE_FUSED dropWhileM #-} +dropWhileM f (Stream step t) = Stream step' (DropWhile_Drop t) + where + -- NOTE: we jump through hoops here to have only one Yield; local data + -- declarations would be nice! + + {-# INLINE_INNER step' #-} + step' (DropWhile_Drop s) + = do + r <- step s + case r of + Yield x s' -> do + b <- f x + return $ if b then Skip (DropWhile_Drop s') + else Skip (DropWhile_Yield x s') + Skip s' -> return $ Skip (DropWhile_Drop s') + Done -> return $ Done + + step' (DropWhile_Yield x s) = return $ Yield x (DropWhile_Next s) + + step' (DropWhile_Next s) + = liftM (\r -> + case r of + Yield x s' -> Skip (DropWhile_Yield x s') + Skip s' -> Skip (DropWhile_Next s') + Done -> Done + ) (step s) + +-- Searching +-- --------- + +infix 4 `elem` +-- | Check whether the 'Stream' contains an element +elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool +{-# INLINE_FUSED elem #-} +elem x (Stream step t) = elem_loop SPEC t + where + elem_loop !_ s + = do + r <- step s + case r of + Yield y s' | x == y -> return True + | otherwise -> elem_loop SPEC s' + Skip s' -> elem_loop SPEC s' + Done -> return False + +infix 4 `notElem` +-- | Inverse of `elem` +notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool +{-# INLINE notElem #-} +notElem x s = liftM not (elem x s) + +-- | Yield 'Just' the first element that satisfies the predicate or 'Nothing' +-- if no such element exists. +find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a) +{-# INLINE find #-} +find f = findM (return . f) + +-- | Yield 'Just' the first element that satisfies the monadic predicate or +-- 'Nothing' if no such element exists. +findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a) +{-# INLINE_FUSED findM #-} +findM f (Stream step t) = find_loop SPEC t + where + find_loop !_ s + = do + r <- step s + case r of + Yield x s' -> do + b <- f x + if b then return $ Just x + else find_loop SPEC s' + Skip s' -> find_loop SPEC s' + Done -> return Nothing + +-- | Yield 'Just' the index of the first element that satisfies the predicate +-- or 'Nothing' if no such element exists. +findIndex :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe Int) +{-# INLINE_FUSED findIndex #-} +findIndex f = findIndexM (return . f) + +-- | Yield 'Just' the index of the first element that satisfies the monadic +-- predicate or 'Nothing' if no such element exists. +findIndexM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe Int) +{-# INLINE_FUSED findIndexM #-} +findIndexM f (Stream step t) = findIndex_loop SPEC t 0 + where + findIndex_loop !_ s i + = do + r <- step s + case r of + Yield x s' -> do + b <- f x + if b then return $ Just i + else findIndex_loop SPEC s' (i+1) + Skip s' -> findIndex_loop SPEC s' i + Done -> return Nothing + +-- Folding +-- ------- + +-- | Left fold +foldl :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a +{-# INLINE foldl #-} +foldl f = foldlM (\a b -> return (f a b)) + +-- | Left fold with a monadic operator +foldlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a +{-# INLINE_FUSED foldlM #-} +foldlM m w (Stream step t) = foldlM_loop SPEC w t + where + foldlM_loop !_ z s + = do + r <- step s + case r of + Yield x s' -> do { z' <- m z x; foldlM_loop SPEC z' s' } + Skip s' -> foldlM_loop SPEC z s' + Done -> return z + +-- | Same as 'foldlM' +foldM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a +{-# INLINE foldM #-} +foldM = foldlM + +-- | Left fold over a non-empty 'Stream' +foldl1 :: Monad m => (a -> a -> a) -> Stream m a -> m a +{-# INLINE foldl1 #-} +foldl1 f = foldl1M (\a b -> return (f a b)) + +-- | Left fold over a non-empty 'Stream' with a monadic operator +foldl1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a +{-# INLINE_FUSED foldl1M #-} +foldl1M f (Stream step t) = foldl1M_loop SPEC t + where + foldl1M_loop !_ s + = do + r <- step s + case r of + Yield x s' -> foldlM f x (Stream step s') + Skip s' -> foldl1M_loop SPEC s' + Done -> EMPTY_STREAM "foldl1M" + +-- | Same as 'foldl1M' +fold1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a +{-# INLINE fold1M #-} +fold1M = foldl1M + +-- | Left fold with a strict accumulator +foldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a +{-# INLINE foldl' #-} +foldl' f = foldlM' (\a b -> return (f a b)) + +-- | Left fold with a strict accumulator and a monadic operator +foldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a +{-# INLINE_FUSED foldlM' #-} +foldlM' m w (Stream step t) = foldlM'_loop SPEC w t + where + foldlM'_loop !_ z s + = z `seq` + do + r <- step s + case r of + Yield x s' -> do { z' <- m z x; foldlM'_loop SPEC z' s' } + Skip s' -> foldlM'_loop SPEC z s' + Done -> return z + +-- | Same as 'foldlM'' +foldM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a +{-# INLINE foldM' #-} +foldM' = foldlM' + +-- | Left fold over a non-empty 'Stream' with a strict accumulator +foldl1' :: Monad m => (a -> a -> a) -> Stream m a -> m a +{-# INLINE foldl1' #-} +foldl1' f = foldl1M' (\a b -> return (f a b)) + +-- | Left fold over a non-empty 'Stream' with a strict accumulator and a +-- monadic operator +foldl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a +{-# INLINE_FUSED foldl1M' #-} +foldl1M' f (Stream step t) = foldl1M'_loop SPEC t + where + foldl1M'_loop !_ s + = do + r <- step s + case r of + Yield x s' -> foldlM' f x (Stream step s') + Skip s' -> foldl1M'_loop SPEC s' + Done -> EMPTY_STREAM "foldl1M'" + +-- | Same as 'foldl1M'' +fold1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a +{-# INLINE fold1M' #-} +fold1M' = foldl1M' + +-- | Right fold +foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b +{-# INLINE foldr #-} +foldr f = foldrM (\a b -> return (f a b)) + +-- | Right fold with a monadic operator +foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b +{-# INLINE_FUSED foldrM #-} +foldrM f z (Stream step t) = foldrM_loop SPEC t + where + foldrM_loop !_ s + = do + r <- step s + case r of + Yield x s' -> f x =<< foldrM_loop SPEC s' + Skip s' -> foldrM_loop SPEC s' + Done -> return z + +-- | Right fold over a non-empty stream +foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m a +{-# INLINE foldr1 #-} +foldr1 f = foldr1M (\a b -> return (f a b)) + +-- | Right fold over a non-empty stream with a monadic operator +foldr1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a +{-# INLINE_FUSED foldr1M #-} +foldr1M f (Stream step t) = foldr1M_loop0 SPEC t + where + foldr1M_loop0 !_ s + = do + r <- step s + case r of + Yield x s' -> foldr1M_loop1 SPEC x s' + Skip s' -> foldr1M_loop0 SPEC s' + Done -> EMPTY_STREAM "foldr1M" + + foldr1M_loop1 !_ x s + = do + r <- step s + case r of + Yield y s' -> f x =<< foldr1M_loop1 SPEC y s' + Skip s' -> foldr1M_loop1 SPEC x s' + Done -> return x + +-- Specialised folds +-- ----------------- + +and :: Monad m => Stream m Bool -> m Bool +{-# INLINE_FUSED and #-} +and (Stream step t) = and_loop SPEC t + where + and_loop !_ s + = do + r <- step s + case r of + Yield False _ -> return False + Yield True s' -> and_loop SPEC s' + Skip s' -> and_loop SPEC s' + Done -> return True + +or :: Monad m => Stream m Bool -> m Bool +{-# INLINE_FUSED or #-} +or (Stream step t) = or_loop SPEC t + where + or_loop !_ s + = do + r <- step s + case r of + Yield False s' -> or_loop SPEC s' + Yield True _ -> return True + Skip s' -> or_loop SPEC s' + Done -> return False + +concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b +{-# INLINE concatMap #-} +concatMap f = concatMapM (return . f) + +concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b +{-# INLINE_FUSED concatMapM #-} +concatMapM f (Stream step t) = Stream concatMap_go (Left t) + where + concatMap_go (Left s) = do + r <- step s + case r of + Yield a s' -> do + b_stream <- f a + return $ Skip (Right (b_stream, s')) + Skip s' -> return $ Skip (Left s') + Done -> return Done + concatMap_go (Right (Stream inner_step inner_s, s)) = do + r <- inner_step inner_s + case r of + Yield b inner_s' -> return $ Yield b (Right (Stream inner_step inner_s', s)) + Skip inner_s' -> return $ Skip (Right (Stream inner_step inner_s', s)) + Done -> return $ Skip (Left s) + +-- | Create a 'Stream' of values from a 'Stream' of streamable things +flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b +{-# INLINE_FUSED flatten #-} +flatten mk istep (Stream ostep u) = Stream step (Left u) + where + {-# INLINE_INNER step #-} + step (Left t) = do + r <- ostep t + case r of + Yield a t' -> do + s <- mk a + s `seq` return (Skip (Right (s,t'))) + Skip t' -> return $ Skip (Left t') + Done -> return $ Done + + + step (Right (s,t)) = do + r <- istep s + case r of + Yield x s' -> return $ Yield x (Right (s',t)) + Skip s' -> return $ Skip (Right (s',t)) + Done -> return $ Skip (Left t) + +-- Unfolding +-- --------- + +-- | Unfold +unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a +{-# INLINE_FUSED unfoldr #-} +unfoldr f = unfoldrM (return . f) + +-- | Unfold with a monadic function +unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a +{-# INLINE_FUSED unfoldrM #-} +unfoldrM f t = Stream step t + where + {-# INLINE_INNER step #-} + step s = liftM (\r -> + case r of + Just (x, s') -> Yield x s' + Nothing -> Done + ) (f s) + +unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Stream m a +{-# INLINE_FUSED unfoldrN #-} +unfoldrN n f = unfoldrNM n (return . f) + +-- | Unfold at most @n@ elements with a monadic functions +unfoldrNM :: Monad m => Int -> (s -> m (Maybe (a, s))) -> s -> Stream m a +{-# INLINE_FUSED unfoldrNM #-} +unfoldrNM m f t = Stream step (t,m) + where + {-# INLINE_INNER step #-} + step (s,n) | n <= 0 = return Done + | otherwise = liftM (\r -> + case r of + Just (x,s') -> Yield x (s',n-1) + Nothing -> Done + ) (f s) + +-- | Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: Monad m => Int -> (a -> m a) -> a -> Stream m a +{-# INLINE_FUSED iterateNM #-} +iterateNM n f x0 = Stream step (x0,n) + where + {-# INLINE_INNER step #-} + step (x,i) | i <= 0 = return Done + | i == n = return $ Yield x (x,i-1) + | otherwise = do a <- f x + return $ Yield a (a,i-1) + +-- | Apply function n times to value. Zeroth element is original value. +iterateN :: Monad m => Int -> (a -> a) -> a -> Stream m a +{-# INLINE_FUSED iterateN #-} +iterateN n f x0 = iterateNM n (return . f) x0 + +-- Scans +-- ----- + +-- | Prefix scan +prescanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a +{-# INLINE prescanl #-} +prescanl f = prescanlM (\a b -> return (f a b)) + +-- | Prefix scan with a monadic operator +prescanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a +{-# INLINE_FUSED prescanlM #-} +prescanlM f w (Stream step t) = Stream step' (t,w) + where + {-# INLINE_INNER step' #-} + step' (s,x) = do + r <- step s + case r of + Yield y s' -> do + z <- f x y + return $ Yield x (s', z) + Skip s' -> return $ Skip (s', x) + Done -> return Done + +-- | Prefix scan with strict accumulator +prescanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a +{-# INLINE prescanl' #-} +prescanl' f = prescanlM' (\a b -> return (f a b)) + +-- | Prefix scan with strict accumulator and a monadic operator +prescanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a +{-# INLINE_FUSED prescanlM' #-} +prescanlM' f w (Stream step t) = Stream step' (t,w) + where + {-# INLINE_INNER step' #-} + step' (s,x) = x `seq` + do + r <- step s + case r of + Yield y s' -> do + z <- f x y + return $ Yield x (s', z) + Skip s' -> return $ Skip (s', x) + Done -> return Done + +-- | Suffix scan +postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a +{-# INLINE postscanl #-} +postscanl f = postscanlM (\a b -> return (f a b)) + +-- | Suffix scan with a monadic operator +postscanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a +{-# INLINE_FUSED postscanlM #-} +postscanlM f w (Stream step t) = Stream step' (t,w) + where + {-# INLINE_INNER step' #-} + step' (s,x) = do + r <- step s + case r of + Yield y s' -> do + z <- f x y + return $ Yield z (s',z) + Skip s' -> return $ Skip (s',x) + Done -> return Done + +-- | Suffix scan with strict accumulator +postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a +{-# INLINE postscanl' #-} +postscanl' f = postscanlM' (\a b -> return (f a b)) + +-- | Suffix scan with strict acccumulator and a monadic operator +postscanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a +{-# INLINE_FUSED postscanlM' #-} +postscanlM' f w (Stream step t) = w `seq` Stream step' (t,w) + where + {-# INLINE_INNER step' #-} + step' (s,x) = x `seq` + do + r <- step s + case r of + Yield y s' -> do + z <- f x y + z `seq` return (Yield z (s',z)) + Skip s' -> return $ Skip (s',x) + Done -> return Done + +-- | Haskell-style scan +scanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a +{-# INLINE scanl #-} +scanl f = scanlM (\a b -> return (f a b)) + +-- | Haskell-style scan with a monadic operator +scanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a +{-# INLINE scanlM #-} +scanlM f z s = z `cons` postscanlM f z s + +-- | Haskell-style scan with strict accumulator +scanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a +{-# INLINE scanl' #-} +scanl' f = scanlM' (\a b -> return (f a b)) + +-- | Haskell-style scan with strict accumulator and a monadic operator +scanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a +{-# INLINE scanlM' #-} +scanlM' f z s = z `seq` (z `cons` postscanlM f z s) + +-- | Scan over a non-empty 'Stream' +scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a +{-# INLINE scanl1 #-} +scanl1 f = scanl1M (\x y -> return (f x y)) + +-- | Scan over a non-empty 'Stream' with a monadic operator +scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a +{-# INLINE_FUSED scanl1M #-} +scanl1M f (Stream step t) = Stream step' (t, Nothing) + where + {-# INLINE_INNER step' #-} + step' (s, Nothing) = do + r <- step s + case r of + Yield x s' -> return $ Yield x (s', Just x) + Skip s' -> return $ Skip (s', Nothing) + Done -> EMPTY_STREAM "scanl1M" + + step' (s, Just x) = do + r <- step s + case r of + Yield y s' -> do + z <- f x y + return $ Yield z (s', Just z) + Skip s' -> return $ Skip (s', Just x) + Done -> return Done + +-- | Scan over a non-empty 'Stream' with a strict accumulator +scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a +{-# INLINE scanl1' #-} +scanl1' f = scanl1M' (\x y -> return (f x y)) + +-- | Scan over a non-empty 'Stream' with a strict accumulator and a monadic +-- operator +scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a +{-# INLINE_FUSED scanl1M' #-} +scanl1M' f (Stream step t) = Stream step' (t, Nothing) + where + {-# INLINE_INNER step' #-} + step' (s, Nothing) = do + r <- step s + case r of + Yield x s' -> x `seq` return (Yield x (s', Just x)) + Skip s' -> return $ Skip (s', Nothing) + Done -> EMPTY_STREAM "scanl1M" + + step' (s, Just x) = x `seq` + do + r <- step s + case r of + Yield y s' -> do + z <- f x y + z `seq` return (Yield z (s', Just z)) + Skip s' -> return $ Skip (s', Just x) + Done -> return Done + +-- Enumerations +-- ------------ + +-- The Enum class is broken for this, there just doesn't seem to be a +-- way to implement this generically. We have to specialise for as many types +-- as we can but this doesn't help in polymorphic loops. + +-- | Yield a 'Stream' of the given length containing the values @x@, @x+y@, +-- @x+y+y@ etc. +enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Stream m a +{-# INLINE_FUSED enumFromStepN #-} +enumFromStepN x y n = x `seq` y `seq` n `seq` Stream step (x,n) + where + {-# INLINE_INNER step #-} + step (w,m) | m > 0 = return $ Yield w (w+y,m-1) + | otherwise = return $ Done + +-- | Enumerate values +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromTo :: (Enum a, Monad m) => a -> a -> Stream m a +{-# INLINE_FUSED enumFromTo #-} +enumFromTo x y = fromList [x .. y] + +-- NOTE: We use (x+1) instead of (succ x) below because the latter checks for +-- overflow which can't happen here. + +-- FIXME: add "too large" test for Int +enumFromTo_small :: (Integral a, Monad m) => a -> a -> Stream m a +{-# INLINE_FUSED enumFromTo_small #-} +enumFromTo_small x y = x `seq` y `seq` Stream step x + where + {-# INLINE_INNER step #-} + step w | w <= y = return $ Yield w (w+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Int8> [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Stream m Int8 + +"enumFromTo<Int16> [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Stream m Int16 + +"enumFromTo<Word8> [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Stream m Word8 + +"enumFromTo<Word16> [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Stream m Word16 #-} + + +#if WORD_SIZE_IN_BITS > 32 + +{-# RULES + +"enumFromTo<Int32> [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Stream m Int32 + +"enumFromTo<Word32> [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Stream m Word32 #-} + + +#endif + +-- NOTE: We could implement a generic "too large" test: +-- +-- len x y | x > y = 0 +-- | n > 0 && n <= fromIntegral (maxBound :: Int) = fromIntegral n +-- | otherwise = error +-- where +-- n = y-x+1 +-- +-- Alas, GHC won't eliminate unnecessary comparisons (such as n >= 0 for +-- unsigned types). See http://hackage.haskell.org/trac/ghc/ticket/3744 +-- + +enumFromTo_int :: forall m. Monad m => Int -> Int -> Stream m Int +{-# INLINE_FUSED enumFromTo_int #-} +enumFromTo_int x y = x `seq` y `seq` Stream step x + where + -- {-# INLINE [0] len #-} + -- len :: Int -> Int -> Int + -- len u v | u > v = 0 + -- | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" + -- (n > 0) + -- $ n + -- where + -- n = v-u+1 + + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +enumFromTo_intlike :: (Integral a, Monad m) => a -> a -> Stream m a +{-# INLINE_FUSED enumFromTo_intlike #-} +enumFromTo_intlike x y = x `seq` y `seq` Stream step x + where + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Int> [Stream]" + enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Stream m Int + +#if WORD_SIZE_IN_BITS > 32 + +"enumFromTo<Int64> [Stream]" + enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Stream m Int64 #-} + +#else + +"enumFromTo<Int32> [Stream]" + enumFromTo = enumFromTo_intlike :: Monad m => Int32 -> Int32 -> Stream m Int32 #-} + +#endif + +enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Stream m a +{-# INLINE_FUSED enumFromTo_big_word #-} +enumFromTo_big_word x y = x `seq` y `seq` Stream step x + where + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Word> [Stream]" + enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Stream m Word + +"enumFromTo<Word64> [Stream]" + enumFromTo = enumFromTo_big_word + :: Monad m => Word64 -> Word64 -> Stream m Word64 + +#if WORD_SIZE_IN_BITS == 32 + +"enumFromTo<Word32> [Stream]" + enumFromTo = enumFromTo_big_word + :: Monad m => Word32 -> Word32 -> Stream m Word32 + +#endif + +"enumFromTo<Integer> [Stream]" + enumFromTo = enumFromTo_big_word + :: Monad m => Integer -> Integer -> Stream m Integer #-} + + + +#if WORD_SIZE_IN_BITS > 32 + +-- FIXME: the "too large" test is totally wrong +enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Stream m a +{-# INLINE_FUSED enumFromTo_big_int #-} +enumFromTo_big_int x y = x `seq` y `seq` Stream step x + where + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Int64> [Stream]" + enumFromTo = enumFromTo_big_int :: Monad m => Int64 -> Int64 -> Stream m Int64 #-} + + + +#endif + +enumFromTo_char :: Monad m => Char -> Char -> Stream m Char +{-# INLINE_FUSED enumFromTo_char #-} +enumFromTo_char x y = x `seq` y `seq` Stream step xn + where + xn = ord x + yn = ord y + + {-# INLINE_INNER step #-} + step zn | zn <= yn = return $ Yield (unsafeChr zn) (zn+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Char> [Stream]" + enumFromTo = enumFromTo_char #-} + + + +------------------------------------------------------------------------ + +-- Specialise enumFromTo for Float and Double. +-- Also, try to do something about pairs? + +enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Stream m a +{-# INLINE_FUSED enumFromTo_double #-} +enumFromTo_double n m = n `seq` m `seq` Stream step n + where + lim = m + 1/2 -- important to float out + + {-# INLINE_INNER step #-} + step x | x <= lim = return $ Yield x (x+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Double> [Stream]" + enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Stream m Double + +"enumFromTo<Float> [Stream]" + enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Stream m Float #-} + + + +------------------------------------------------------------------------ + +-- | Enumerate values with a given step. +-- +-- /WARNING:/ This operation is very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Enum a, Monad m) => a -> a -> a -> Stream m a +{-# INLINE_FUSED enumFromThenTo #-} +enumFromThenTo x y z = fromList [x, y .. z] + +-- FIXME: Specialise enumFromThenTo. + +-- Conversions +-- ----------- + +-- | Convert a 'Stream' to a list +toList :: Monad m => Stream m a -> m [a] +{-# INLINE toList #-} +toList = foldr (:) [] + +-- | Convert a list to a 'Stream' +fromList :: Monad m => [a] -> Stream m a +{-# INLINE fromList #-} +fromList zs = Stream step zs + where + step (x:xs) = return (Yield x xs) + step [] = return Done + +-- | Convert the first @n@ elements of a list to a 'Bundle' +fromListN :: Monad m => Int -> [a] -> Stream m a +{-# INLINE_FUSED fromListN #-} +fromListN m zs = Stream step (zs,m) + where + {-# INLINE_INNER step #-} + step (_, n) | n <= 0 = return Done + step (x:xs,n) = return (Yield x (xs,n-1)) + step ([],_) = return Done + +{- +fromVector :: (Monad m, Vector v a) => v a -> Stream m a +{-# INLINE_FUSED fromVector #-} +fromVector v = v `seq` n `seq` Stream (Unf step 0) + (Unf vstep True) + (Just v) + (Exact n) + where + n = basicLength v + + {-# INLINE step #-} + step i | i >= n = return Done + | otherwise = case basicUnsafeIndexM v i of + Box x -> return $ Yield x (i+1) + + + {-# INLINE vstep #-} + vstep True = return (Yield (Chunk (basicLength v) (\mv -> basicUnsafeCopy mv v)) False) + vstep False = return Done + +fromVectors :: forall m a. (Monad m, Vector v a) => [v a] -> Stream m a +{-# INLINE_FUSED fromVectors #-} +fromVectors vs = Stream (Unf pstep (Left vs)) + (Unf vstep vs) + Nothing + (Exact n) + where + n = List.foldl' (\k v -> k + basicLength v) 0 vs + + pstep (Left []) = return Done + pstep (Left (v:vs)) = basicLength v `seq` return (Skip (Right (v,0,vs))) + + pstep (Right (v,i,vs)) + | i >= basicLength v = return $ Skip (Left vs) + | otherwise = case basicUnsafeIndexM v i of + Box x -> return $ Yield x (Right (v,i+1,vs)) + + -- FIXME: work around bug in GHC 7.6.1 + vstep :: [v a] -> m (Step [v a] (Chunk v a)) + vstep [] = return Done + vstep (v:vs) = return $ Yield (Chunk (basicLength v) + (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch" + (M.basicLength mv == basicLength v) + $ basicUnsafeCopy mv v)) vs + + +concatVectors :: (Monad m, Vector v a) => Stream m (v a) -> Stream m a +{-# INLINE_FUSED concatVectors #-} +concatVectors (Stream step s} + = Stream (Unf pstep (Left s)) + (Unf vstep s) + Nothing + Unknown + where + pstep (Left s) = do + r <- step s + case r of + Yield v s' -> basicLength v `seq` return (Skip (Right (v,0,s'))) + Skip s' -> return (Skip (Left s')) + Done -> return Done + + pstep (Right (v,i,s)) + | i >= basicLength v = return (Skip (Left s)) + | otherwise = case basicUnsafeIndexM v i of + Box x -> return (Yield x (Right (v,i+1,s))) + + + vstep s = do + r <- step s + case r of + Yield v s' -> return (Yield (Chunk (basicLength v) + (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch" + (M.basicLength mv == basicLength v) + $ basicUnsafeCopy mv v)) s') + Skip s' -> return (Skip s') + Done -> return Done + +reVector :: Monad m => Stream m a -> Stream m a +{-# INLINE_FUSED reVector #-} +reVector (Stream step s, sSize = n} = Stream step s n + +{-# RULES + +"reVector [Vector]" + reVector = id + +"reVector/reVector [Vector]" forall s. + reVector (reVector s) = s #-} + + +-} + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Util.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Util.hs new file mode 100644 index 0000000000..855bf5ddd4 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Util.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE CPP #-} +-- | +-- Module : Data.Vector.Fusion.Util +-- Copyright : (c) Roman Leshchinskiy 2009 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : portable +-- +-- Fusion-related utility types +-- + +module Data.Vector.Fusion.Util ( + Id(..), Box(..), + + delay_inline, delayed_min +) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative (Applicative(..)) +#endif + +-- | Identity monad +newtype Id a = Id { unId :: a } + +instance Functor Id where + fmap f (Id x) = Id (f x) + +instance Applicative Id where + pure = Id + Id f <*> Id x = Id (f x) + +instance Monad Id where + return = pure + Id x >>= f = f x + +-- | Box monad +data Box a = Box { unBox :: a } + +instance Functor Box where + fmap f (Box x) = Box (f x) + +instance Applicative Box where + pure = Box + Box f <*> Box x = Box (f x) + +instance Monad Box where + return = pure + Box x >>= f = f x + +-- | Delay inlining a function until late in the game (simplifier phase 0). +delay_inline :: (a -> b) -> a -> b +{-# INLINE [0] delay_inline #-} +delay_inline f = f + +-- | `min` inlined in phase 0 +delayed_min :: Int -> Int -> Int +{-# INLINE [0] delayed_min #-} +delayed_min m n = min m n diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic.hs new file mode 100644 index 0000000000..066c07fd3d --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic.hs @@ -0,0 +1,2206 @@ +{-# LANGUAGE CPP, Rank2Types, MultiParamTypeClasses, FlexibleContexts, + TypeFamilies, ScopedTypeVariables, BangPatterns #-} +-- | +-- Module : Data.Vector.Generic +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Generic interface to pure vectors. +-- + +module Data.Vector.Generic ( + -- * Immutable vectors + Vector(..), Mutable, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + unsafeIndex, unsafeHead, unsafeLast, + + -- ** Monadic indexing + indexM, headM, lastM, + unsafeIndexM, unsafeHeadM, unsafeLastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, iterateNM, create, createT, + + -- ** Unfolding + unfoldr, unfoldrN, + unfoldrM, unfoldrNM, + constructN, constructrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, concatNE, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update, update_, + unsafeUpd, unsafeUpdate, unsafeUpdate_, + + -- ** Accumulations + accum, accumulate, accumulate_, + unsafeAccum, unsafeAccumulate, unsafeAccumulate_, + + -- ** Permutations + reverse, backpermute, unsafeBackpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Indexing + indexed, + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, imapM, mapM_, imapM_, forM, forM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + zip, zip3, zip4, zip5, zip6, + + -- ** Monadic zipping + zipWithM, izipWithM, zipWithM_, izipWithM_, + + -- ** Unzipping + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, uniq, + mapMaybe, imapMaybe, + filterM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, span, break, + + -- ** Searching + elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + + -- ** Specialised folds + all, any, and, or, + sum, product, + maximum, maximumBy, minimum, minimumBy, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, ifoldM, foldM', ifoldM', + fold1M, fold1M', foldM_, ifoldM_, + foldM'_, ifoldM'_, fold1M_, fold1M'_, + + -- ** Monadic sequencing + sequence, sequence_, + + -- * Prefix sums (scans) + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + iscanl, iscanl', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + iscanr, iscanr', + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Different vector types + convert, + + -- ** Mutable vectors + freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy, + + -- * Fusion support + + -- ** Conversion to/from Bundles + stream, unstream, streamR, unstreamR, + + -- ** Recycling support + new, clone, + + -- * Utilities + + -- ** Comparisons + eq, cmp, + eqBy, cmpBy, + + -- ** Show and Read + showsPrec, readPrec, + liftShowsPrec, liftReadsPrec, + + -- ** @Data@ and @Typeable@ + gfoldl, dataCast, mkType +) where + +import Data.Vector.Generic.Base + +import qualified Data.Vector.Generic.Mutable as M + +import qualified Data.Vector.Generic.New as New +import Data.Vector.Generic.New ( New ) + +import qualified Data.Vector.Fusion.Bundle as Bundle +import Data.Vector.Fusion.Bundle ( Bundle, MBundle, lift, inplace ) +import qualified Data.Vector.Fusion.Bundle.Monadic as MBundle +import Data.Vector.Fusion.Stream.Monadic ( Stream ) +import qualified Data.Vector.Fusion.Stream.Monadic as S +import Data.Vector.Fusion.Bundle.Size +import Data.Vector.Fusion.Util + +import Control.Monad.ST ( ST, runST ) +import Control.Monad.Primitive +import Prelude hiding ( length, null, + replicate, (++), concat, + head, last, + init, tail, take, drop, splitAt, reverse, + map, concat, concatMap, + zipWith, zipWith3, zip, zip3, unzip, unzip3, + filter, takeWhile, dropWhile, span, break, + elem, notElem, + foldl, foldl1, foldr, foldr1, + all, any, and, or, sum, product, maximum, minimum, + scanl, scanl1, scanr, scanr1, + enumFromTo, enumFromThenTo, + mapM, mapM_, sequence, sequence_, + showsPrec ) + +import qualified Text.Read as Read +import qualified Data.List.NonEmpty as NonEmpty + +#if __GLASGOW_HASKELL__ >= 707 +import Data.Typeable ( Typeable, gcast1 ) +#else +import Data.Typeable ( Typeable1, gcast1 ) +#endif + +#include "vector.h" + +import Data.Data ( Data, DataType ) +#if MIN_VERSION_base(4,2,0) +import Data.Data ( mkNoRepType ) +#else +import Data.Data ( mkNorepType ) +mkNoRepType :: String -> DataType +mkNoRepType = mkNorepType +#endif + +import qualified Data.Traversable as T (Traversable(mapM)) + +-- Length information +-- ------------------ + +-- | /O(1)/ Yield the length of the vector +length :: Vector v a => v a -> Int +{-# INLINE length #-} +length = Bundle.length . stream' + +-- | /O(1)/ Test whether a vector is empty +null :: Vector v a => v a -> Bool +{-# INLINE null #-} +null = Bundle.null . stream + +-- Indexing +-- -------- + +infixl 9 ! +-- | O(1) Indexing +(!) :: Vector v a => v a -> Int -> a +{-# INLINE_FUSED (!) #-} +(!) v i = BOUNDS_CHECK(checkIndex) "(!)" i (length v) + $ unId (basicUnsafeIndexM v i) + +infixl 9 !? +-- | O(1) Safe indexing +(!?) :: Vector v a => v a -> Int -> Maybe a +{-# INLINE_FUSED (!?) #-} +v !? i | i < 0 || i >= length v = Nothing + | otherwise = Just $ unsafeIndex v i + +-- | /O(1)/ First element +head :: Vector v a => v a -> a +{-# INLINE_FUSED head #-} +head v = v ! 0 + +-- | /O(1)/ Last element +last :: Vector v a => v a -> a +{-# INLINE_FUSED last #-} +last v = v ! (length v - 1) + +-- | /O(1)/ Unsafe indexing without bounds checking +unsafeIndex :: Vector v a => v a -> Int -> a +{-# INLINE_FUSED unsafeIndex #-} +unsafeIndex v i = UNSAFE_CHECK(checkIndex) "unsafeIndex" i (length v) + $ unId (basicUnsafeIndexM v i) + +-- | /O(1)/ First element without checking if the vector is empty +unsafeHead :: Vector v a => v a -> a +{-# INLINE_FUSED unsafeHead #-} +unsafeHead v = unsafeIndex v 0 + +-- | /O(1)/ Last element without checking if the vector is empty +unsafeLast :: Vector v a => v a -> a +{-# INLINE_FUSED unsafeLast #-} +unsafeLast v = unsafeIndex v (length v - 1) + +{-# RULES + +"(!)/unstream [Vector]" forall i s. + new (New.unstream s) ! i = s Bundle.!! i + +"(!?)/unstream [Vector]" forall i s. + new (New.unstream s) !? i = s Bundle.!? i + +"head/unstream [Vector]" forall s. + head (new (New.unstream s)) = Bundle.head s + +"last/unstream [Vector]" forall s. + last (new (New.unstream s)) = Bundle.last s + +"unsafeIndex/unstream [Vector]" forall i s. + unsafeIndex (new (New.unstream s)) i = s Bundle.!! i + +"unsafeHead/unstream [Vector]" forall s. + unsafeHead (new (New.unstream s)) = Bundle.head s + +"unsafeLast/unstream [Vector]" forall s. + unsafeLast (new (New.unstream s)) = Bundle.last s #-} + + + +-- Monadic indexing +-- ---------------- + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the vector when necessary. +-- Suppose vector copying is implemented like this: +-- +-- > copy mv v = ... write mv i (v ! i) ... +-- +-- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ +-- would unnecessarily retain a reference to @v@ in each element written. +-- +-- With 'indexM', copying can be implemented like this instead: +-- +-- > copy mv v = ... do +-- > x <- indexM v i +-- > write mv i x +-- +-- Here, no references to @v@ are retained because indexing (but /not/ the +-- elements) is evaluated eagerly. +-- +indexM :: (Vector v a, Monad m) => v a -> Int -> m a +{-# INLINE_FUSED indexM #-} +indexM v i = BOUNDS_CHECK(checkIndex) "indexM" i (length v) + $ basicUnsafeIndexM v i + +-- | /O(1)/ First element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +headM :: (Vector v a, Monad m) => v a -> m a +{-# INLINE_FUSED headM #-} +headM v = indexM v 0 + +-- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +lastM :: (Vector v a, Monad m) => v a -> m a +{-# INLINE_FUSED lastM #-} +lastM v = indexM v (length v - 1) + +-- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an +-- explanation of why this is useful. +unsafeIndexM :: (Vector v a, Monad m) => v a -> Int -> m a +{-# INLINE_FUSED unsafeIndexM #-} +unsafeIndexM v i = UNSAFE_CHECK(checkIndex) "unsafeIndexM" i (length v) + $ basicUnsafeIndexM v i + +-- | /O(1)/ First element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeHeadM :: (Vector v a, Monad m) => v a -> m a +{-# INLINE_FUSED unsafeHeadM #-} +unsafeHeadM v = unsafeIndexM v 0 + +-- | /O(1)/ Last element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeLastM :: (Vector v a, Monad m) => v a -> m a +{-# INLINE_FUSED unsafeLastM #-} +unsafeLastM v = unsafeIndexM v (length v - 1) + +{-# RULES + +"indexM/unstream [Vector]" forall s i. + indexM (new (New.unstream s)) i = lift s MBundle.!! i + +"headM/unstream [Vector]" forall s. + headM (new (New.unstream s)) = MBundle.head (lift s) + +"lastM/unstream [Vector]" forall s. + lastM (new (New.unstream s)) = MBundle.last (lift s) + +"unsafeIndexM/unstream [Vector]" forall s i. + unsafeIndexM (new (New.unstream s)) i = lift s MBundle.!! i + +"unsafeHeadM/unstream [Vector]" forall s. + unsafeHeadM (new (New.unstream s)) = MBundle.head (lift s) + +"unsafeLastM/unstream [Vector]" forall s. + unsafeLastM (new (New.unstream s)) = MBundle.last (lift s) #-} + + + +-- Extracting subvectors (slicing) +-- ------------------------------- + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Vector v a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> v a + -> v a +{-# INLINE_FUSED slice #-} +slice i n v = BOUNDS_CHECK(checkSlice) "slice" i n (length v) + $ basicUnsafeSlice i n v + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty. +init :: Vector v a => v a -> v a +{-# INLINE_FUSED init #-} +init v = slice 0 (length v - 1) v + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty. +tail :: Vector v a => v a -> v a +{-# INLINE_FUSED tail #-} +tail v = slice 1 (length v - 1) v + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case it is returned unchanged. +take :: Vector v a => Int -> v a -> v a +{-# INLINE_FUSED take #-} +take n v = unsafeSlice 0 (delay_inline min n' (length v)) v + where n' = max n 0 + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case an empty vector is returned. +drop :: Vector v a => Int -> v a -> v a +{-# INLINE_FUSED drop #-} +drop n v = unsafeSlice (delay_inline min n' len) + (delay_inline max 0 (len - n')) v + where n' = max n 0 + len = length v + +-- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ +-- but slightly more efficient. +{-# INLINE_FUSED splitAt #-} +splitAt :: Vector v a => Int -> v a -> (v a, v a) +splitAt n v = ( unsafeSlice 0 m v + , unsafeSlice m (delay_inline max 0 (len - n')) v + ) + where + m = delay_inline min n' len + n' = max n 0 + len = length v + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must +-- contain at least @i+n@ elements but this is not checked. +unsafeSlice :: Vector v a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> v a + -> v a +{-# INLINE_FUSED unsafeSlice #-} +unsafeSlice i n v = UNSAFE_CHECK(checkSlice) "unsafeSlice" i n (length v) + $ basicUnsafeSlice i n v + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty but this is not checked. +unsafeInit :: Vector v a => v a -> v a +{-# INLINE_FUSED unsafeInit #-} +unsafeInit v = unsafeSlice 0 (length v - 1) v + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty but this is not checked. +unsafeTail :: Vector v a => v a -> v a +{-# INLINE_FUSED unsafeTail #-} +unsafeTail v = unsafeSlice 1 (length v - 1) v + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector must +-- contain at least @n@ elements but this is not checked. +unsafeTake :: Vector v a => Int -> v a -> v a +{-# INLINE unsafeTake #-} +unsafeTake n v = unsafeSlice 0 n v + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector +-- must contain at least @n@ elements but this is not checked. +unsafeDrop :: Vector v a => Int -> v a -> v a +{-# INLINE unsafeDrop #-} +unsafeDrop n v = unsafeSlice n (length v - n) v + +{-# RULES + +"slice/new [Vector]" forall i n p. + slice i n (new p) = new (New.slice i n p) + +"init/new [Vector]" forall p. + init (new p) = new (New.init p) + +"tail/new [Vector]" forall p. + tail (new p) = new (New.tail p) + +"take/new [Vector]" forall n p. + take n (new p) = new (New.take n p) + +"drop/new [Vector]" forall n p. + drop n (new p) = new (New.drop n p) + +"unsafeSlice/new [Vector]" forall i n p. + unsafeSlice i n (new p) = new (New.unsafeSlice i n p) + +"unsafeInit/new [Vector]" forall p. + unsafeInit (new p) = new (New.unsafeInit p) + +"unsafeTail/new [Vector]" forall p. + unsafeTail (new p) = new (New.unsafeTail p) #-} + + + +-- Initialisation +-- -------------- + +-- | /O(1)/ Empty vector +empty :: Vector v a => v a +{-# INLINE empty #-} +empty = unstream Bundle.empty + +-- | /O(1)/ Vector with exactly one element +singleton :: forall v a. Vector v a => a -> v a +{-# INLINE singleton #-} +singleton x = elemseq (undefined :: v a) x + $ unstream (Bundle.singleton x) + +-- | /O(n)/ Vector of the given length with the same value in each position +replicate :: forall v a. Vector v a => Int -> a -> v a +{-# INLINE replicate #-} +replicate n x = elemseq (undefined :: v a) x + $ unstream + $ Bundle.replicate n x + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index +generate :: Vector v a => Int -> (Int -> a) -> v a +{-# INLINE generate #-} +generate n f = unstream (Bundle.generate n f) + +-- | /O(n)/ Apply function n times to value. Zeroth element is original value. +iterateN :: Vector v a => Int -> (a -> a) -> a -> v a +{-# INLINE iterateN #-} +iterateN n f x = unstream (Bundle.iterateN n f x) + +-- Unfolding +-- --------- + +-- | /O(n)/ Construct a vector by repeatedly applying the generator function +-- to a seed. The generator function yields 'Just' the next element and the +-- new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 +-- > = <10,9,8,7,6,5,4,3,2,1> +unfoldr :: Vector v a => (b -> Maybe (a, b)) -> b -> v a +{-# INLINE unfoldr #-} +unfoldr f = unstream . Bundle.unfoldr f + +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> +unfoldrN :: Vector v a => Int -> (b -> Maybe (a, b)) -> b -> v a +{-# INLINE unfoldrN #-} +unfoldrN n f = unstream . Bundle.unfoldrN n f + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Vector v a) => (b -> m (Maybe (a, b))) -> b -> m (v a) +{-# INLINE unfoldrM #-} +unfoldrM f = unstreamM . MBundle.unfoldrM f + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Vector v a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (v a) +{-# INLINE unfoldrNM #-} +unfoldrNM n f = unstreamM . MBundle.unfoldrNM n f + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in f <a,b,c> +-- +constructN :: forall v a. Vector v a => Int -> (v a -> a) -> v a +{-# INLINE constructN #-} +-- NOTE: We *CANNOT* wrap this in New and then fuse because the elements +-- might contain references to the immutable vector! +constructN !n f = runST ( + do + v <- M.new n + v' <- unsafeFreeze v + fill v' 0 + ) + where + fill :: forall s. v a -> Int -> ST s (v a) + fill !v i | i < n = let x = f (unsafeTake i v) + in + elemseq v x $ + do + v' <- unsafeThaw v + M.unsafeWrite v' i x + v'' <- unsafeFreeze v' + fill v'' (i+1) + + fill v _ = return v + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in f <c,b,a> +-- +constructrN :: forall v a. Vector v a => Int -> (v a -> a) -> v a +{-# INLINE constructrN #-} +-- NOTE: We *CANNOT* wrap this in New and then fuse because the elements +-- might contain references to the immutable vector! +constructrN !n f = runST ( + do + v <- n `seq` M.new n + v' <- unsafeFreeze v + fill v' 0 + ) + where + fill :: forall s. v a -> Int -> ST s (v a) + fill !v i | i < n = let x = f (unsafeSlice (n-i) i v) + in + elemseq v x $ + do + v' <- unsafeThaw v + M.unsafeWrite v' (n-i-1) x + v'' <- unsafeFreeze v' + fill v'' (i+1) + + fill v _ = return v + + +-- Enumeration +-- ----------- + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ +-- etc. This operation is usually more efficient than 'enumFromTo'. +-- +-- > enumFromN 5 3 = <5,6,7> +enumFromN :: (Vector v a, Num a) => a -> Int -> v a +{-# INLINE enumFromN #-} +enumFromN x n = enumFromStepN x 1 n + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, +-- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. +-- +-- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> +enumFromStepN :: forall v a. (Vector v a, Num a) => a -> a -> Int -> v a +{-# INLINE enumFromStepN #-} +enumFromStepN x y n = elemseq (undefined :: v a) x + $ elemseq (undefined :: v a) y + $ unstream + $ Bundle.enumFromStepN x y n + +-- | /O(n)/ Enumerate values from @x@ to @y@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromN' instead. +enumFromTo :: (Vector v a, Enum a) => a -> a -> v a +{-# INLINE enumFromTo #-} +enumFromTo x y = unstream (Bundle.enumFromTo x y) + +-- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Vector v a, Enum a) => a -> a -> a -> v a +{-# INLINE enumFromThenTo #-} +enumFromThenTo x y z = unstream (Bundle.enumFromThenTo x y z) + +-- Concatenation +-- ------------- + +-- | /O(n)/ Prepend an element +cons :: forall v a. Vector v a => a -> v a -> v a +{-# INLINE cons #-} +cons x v = elemseq (undefined :: v a) x + $ unstream + $ Bundle.cons x + $ stream v + +-- | /O(n)/ Append an element +snoc :: forall v a. Vector v a => v a -> a -> v a +{-# INLINE snoc #-} +snoc v x = elemseq (undefined :: v a) x + $ unstream + $ Bundle.snoc (stream v) x + +infixr 5 ++ +-- | /O(m+n)/ Concatenate two vectors +(++) :: Vector v a => v a -> v a -> v a +{-# INLINE (++) #-} +v ++ w = unstream (stream v Bundle.++ stream w) + +-- | /O(n)/ Concatenate all vectors in the list +concat :: Vector v a => [v a] -> v a +{-# INLINE concat #-} +concat = unstream . Bundle.fromVectors +{- +concat vs = unstream (Bundle.flatten mk step (Exact n) (Bundle.fromList vs)) + where + n = List.foldl' (\k v -> k + length v) 0 vs + + {-# INLINE_INNER step #-} + step (v,i,k) + | i < k = case unsafeIndexM v i of + Box x -> Bundle.Yield x (v,i+1,k) + | otherwise = Bundle.Done + + {-# INLINE mk #-} + mk v = let k = length v + in + k `seq` (v,0,k) +-} + +-- | /O(n)/ Concatenate all vectors in the non-empty list +concatNE :: Vector v a => NonEmpty.NonEmpty (v a) -> v a +concatNE = concat . NonEmpty.toList + +-- Monadic initialisation +-- ---------------------- + +-- | /O(n)/ Execute the monadic action the given number of times and store the +-- results in a vector. +replicateM :: (Monad m, Vector v a) => Int -> m a -> m (v a) +{-# INLINE replicateM #-} +replicateM n m = unstreamM (MBundle.replicateM n m) + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +generateM :: (Monad m, Vector v a) => Int -> (Int -> m a) -> m (v a) +{-# INLINE generateM #-} +generateM n f = unstreamM (MBundle.generateM n f) + +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: (Monad m, Vector v a) => Int -> (a -> m a) -> a -> m (v a) +{-# INLINE iterateNM #-} +iterateNM n f x = unstreamM (MBundle.iterateNM n f x) + +-- | Execute the monadic action and freeze the resulting vector. +-- +-- @ +-- create (do { v \<- 'M.new' 2; 'M.write' v 0 \'a\'; 'M.write' v 1 \'b\'; return v }) = \<'a','b'\> +-- @ +create :: Vector v a => (forall s. ST s (Mutable v s a)) -> v a +{-# INLINE create #-} +create p = new (New.create p) + +-- | Execute the monadic action and freeze the resulting vectors. +createT + :: (T.Traversable f, Vector v a) + => (forall s. ST s (f (Mutable v s a))) -> f (v a) +{-# INLINE createT #-} +createT p = runST (p >>= T.mapM unsafeFreeze) + +-- Restricting memory usage +-- ------------------------ + +-- | /O(n)/ Yield the argument but force it not to retain any extra memory, +-- possibly by copying it. +-- +-- This is especially useful when dealing with slices. For example: +-- +-- > force (slice 0 2 <huge vector>) +-- +-- Here, the slice retains a reference to the huge vector. Forcing it creates +-- a copy of just the elements that belong to the slice and allows the huge +-- vector to be garbage collected. +force :: Vector v a => v a -> v a +-- FIXME: we probably ought to inline this later as the rules still might fire +-- otherwise +{-# INLINE_FUSED force #-} +force v = new (clone v) + +-- Bulk updates +-- ------------ + +-- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector +-- element at position @i@ by @a@. +-- +-- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> +-- +(//) :: Vector v a => v a -- ^ initial vector (of length @m@) + -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) + -> v a +{-# INLINE (//) #-} +v // us = update_stream v (Bundle.fromList us) + +-- | /O(m+n)/ For each pair @(i,a)@ from the vector of index/value pairs, +-- replace the vector element at position @i@ by @a@. +-- +-- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7> +-- +update :: (Vector v a, Vector v (Int, a)) + => v a -- ^ initial vector (of length @m@) + -> v (Int, a) -- ^ vector of index/value pairs (of length @n@) + -> v a +{-# INLINE update #-} +update v w = update_stream v (stream w) + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @a@ from the value vector, replace the element of the +-- initial vector at position @i@ by @a@. +-- +-- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> +-- +-- This function is useful for instances of 'Vector' that cannot store pairs. +-- Otherwise, 'update' is probably more convenient. +-- +-- @ +-- update_ xs is ys = 'update' xs ('zip' is ys) +-- @ +update_ :: (Vector v a, Vector v Int) + => v a -- ^ initial vector (of length @m@) + -> v Int -- ^ index vector (of length @n1@) + -> v a -- ^ value vector (of length @n2@) + -> v a +{-# INLINE update_ #-} +update_ v is w = update_stream v (Bundle.zipWith (,) (stream is) (stream w)) + +update_stream :: Vector v a => v a -> Bundle u (Int,a) -> v a +{-# INLINE update_stream #-} +update_stream = modifyWithBundle M.update + +-- | Same as ('//') but without bounds checking. +unsafeUpd :: Vector v a => v a -> [(Int, a)] -> v a +{-# INLINE unsafeUpd #-} +unsafeUpd v us = unsafeUpdate_stream v (Bundle.fromList us) + +-- | Same as 'update' but without bounds checking. +unsafeUpdate :: (Vector v a, Vector v (Int, a)) => v a -> v (Int, a) -> v a +{-# INLINE unsafeUpdate #-} +unsafeUpdate v w = unsafeUpdate_stream v (stream w) + +-- | Same as 'update_' but without bounds checking. +unsafeUpdate_ :: (Vector v a, Vector v Int) => v a -> v Int -> v a -> v a +{-# INLINE unsafeUpdate_ #-} +unsafeUpdate_ v is w + = unsafeUpdate_stream v (Bundle.zipWith (,) (stream is) (stream w)) + +unsafeUpdate_stream :: Vector v a => v a -> Bundle u (Int,a) -> v a +{-# INLINE unsafeUpdate_stream #-} +unsafeUpdate_stream = modifyWithBundle M.unsafeUpdate + +-- Accumulations +-- ------------- + +-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element +-- @a@ at position @i@ by @f a b@. +-- +-- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> +accum :: Vector v a + => (a -> b -> a) -- ^ accumulating function @f@ + -> v a -- ^ initial vector (of length @m@) + -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) + -> v a +{-# INLINE accum #-} +accum f v us = accum_stream f v (Bundle.fromList us) + +-- | /O(m+n)/ For each pair @(i,b)@ from the vector of pairs, replace the vector +-- element @a@ at position @i@ by @f a b@. +-- +-- > accumulate (+) <5,9,2> <(2,4),(1,6),(0,3),(1,7)> = <5+3, 9+6+7, 2+4> +accumulate :: (Vector v a, Vector v (Int, b)) + => (a -> b -> a) -- ^ accumulating function @f@ + -> v a -- ^ initial vector (of length @m@) + -> v (Int,b) -- ^ vector of index/value pairs (of length @n@) + -> v a +{-# INLINE accumulate #-} +accumulate f v us = accum_stream f v (stream us) + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the the value vector, +-- replace the element of the initial vector at +-- position @i@ by @f a b@. +-- +-- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> +-- +-- This function is useful for instances of 'Vector' that cannot store pairs. +-- Otherwise, 'accumulate' is probably more convenient: +-- +-- @ +-- accumulate_ f as is bs = 'accumulate' f as ('zip' is bs) +-- @ +accumulate_ :: (Vector v a, Vector v Int, Vector v b) + => (a -> b -> a) -- ^ accumulating function @f@ + -> v a -- ^ initial vector (of length @m@) + -> v Int -- ^ index vector (of length @n1@) + -> v b -- ^ value vector (of length @n2@) + -> v a +{-# INLINE accumulate_ #-} +accumulate_ f v is xs = accum_stream f v (Bundle.zipWith (,) (stream is) + (stream xs)) + + +accum_stream :: Vector v a => (a -> b -> a) -> v a -> Bundle u (Int,b) -> v a +{-# INLINE accum_stream #-} +accum_stream f = modifyWithBundle (M.accum f) + +-- | Same as 'accum' but without bounds checking. +unsafeAccum :: Vector v a => (a -> b -> a) -> v a -> [(Int,b)] -> v a +{-# INLINE unsafeAccum #-} +unsafeAccum f v us = unsafeAccum_stream f v (Bundle.fromList us) + +-- | Same as 'accumulate' but without bounds checking. +unsafeAccumulate :: (Vector v a, Vector v (Int, b)) + => (a -> b -> a) -> v a -> v (Int,b) -> v a +{-# INLINE unsafeAccumulate #-} +unsafeAccumulate f v us = unsafeAccum_stream f v (stream us) + +-- | Same as 'accumulate_' but without bounds checking. +unsafeAccumulate_ :: (Vector v a, Vector v Int, Vector v b) + => (a -> b -> a) -> v a -> v Int -> v b -> v a +{-# INLINE unsafeAccumulate_ #-} +unsafeAccumulate_ f v is xs + = unsafeAccum_stream f v (Bundle.zipWith (,) (stream is) (stream xs)) + +unsafeAccum_stream + :: Vector v a => (a -> b -> a) -> v a -> Bundle u (Int,b) -> v a +{-# INLINE unsafeAccum_stream #-} +unsafeAccum_stream f = modifyWithBundle (M.unsafeAccum f) + +-- Permutations +-- ------------ + +-- | /O(n)/ Reverse a vector +reverse :: (Vector v a) => v a -> v a +{-# INLINE reverse #-} +-- FIXME: make this fuse better, add support for recycling +reverse = unstream . streamR + +-- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the +-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is +-- often much more efficient. +-- +-- > backpermute <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a> +backpermute :: (Vector v a, Vector v Int) + => v a -- ^ @xs@ value vector + -> v Int -- ^ @is@ index vector (of length @n@) + -> v a +{-# INLINE backpermute #-} +-- This somewhat non-intuitive definition ensures that the resulting vector +-- does not retain references to the original one even if it is lazy in its +-- elements. This would not be the case if we simply used map (v!) +backpermute v is = seq v + $ seq n + $ unstream + $ Bundle.unbox + $ Bundle.map index + $ stream is + where + n = length v + + {-# INLINE index #-} + -- NOTE: we do it this way to avoid triggering LiberateCase on n in + -- polymorphic code + index i = BOUNDS_CHECK(checkIndex) "backpermute" i n + $ basicUnsafeIndexM v i + +-- | Same as 'backpermute' but without bounds checking. +unsafeBackpermute :: (Vector v a, Vector v Int) => v a -> v Int -> v a +{-# INLINE unsafeBackpermute #-} +unsafeBackpermute v is = seq v + $ seq n + $ unstream + $ Bundle.unbox + $ Bundle.map index + $ stream is + where + n = length v + + {-# INLINE index #-} + -- NOTE: we do it this way to avoid triggering LiberateCase on n in + -- polymorphic code + index i = UNSAFE_CHECK(checkIndex) "unsafeBackpermute" i n + $ basicUnsafeIndexM v i + +-- Safe destructive updates +-- ------------------------ + +-- | Apply a destructive operation to a vector. The operation will be +-- performed in place if it is safe to do so and will modify a copy of the +-- vector otherwise. +-- +-- @ +-- modify (\\v -> 'M.write' v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> +-- @ +modify :: Vector v a => (forall s. Mutable v s a -> ST s ()) -> v a -> v a +{-# INLINE modify #-} +modify p = new . New.modify p . clone + +-- We have to make sure that this is strict in the stream but we can't seq on +-- it while fusion is happening. Hence this ugliness. +modifyWithBundle :: Vector v a + => (forall s. Mutable v s a -> Bundle u b -> ST s ()) + -> v a -> Bundle u b -> v a +{-# INLINE modifyWithBundle #-} +modifyWithBundle p v s = new (New.modifyWithBundle p (clone v) s) + +-- Indexing +-- -------- + +-- | /O(n)/ Pair each element in a vector with its index +indexed :: (Vector v a, Vector v (Int,a)) => v a -> v (Int,a) +{-# INLINE indexed #-} +indexed = unstream . Bundle.indexed . stream + +-- Mapping +-- ------- + +-- | /O(n)/ Map a function over a vector +map :: (Vector v a, Vector v b) => (a -> b) -> v a -> v b +{-# INLINE map #-} +map f = unstream . inplace (S.map f) id . stream + +-- | /O(n)/ Apply a function to every element of a vector and its index +imap :: (Vector v a, Vector v b) => (Int -> a -> b) -> v a -> v b +{-# INLINE imap #-} +imap f = unstream . inplace (S.map (uncurry f) . S.indexed) id + . stream + +-- | Map a function over a vector and concatenate the results. +concatMap :: (Vector v a, Vector v b) => (a -> v b) -> v a -> v b +{-# INLINE concatMap #-} +-- NOTE: We can't fuse concatMap anyway so don't pretend we do. +-- This seems to be slightly slower +-- concatMap f = concat . Bundle.toList . Bundle.map f . stream + +-- Slowest +-- concatMap f = unstream . Bundle.concatMap (stream . f) . stream + +-- Used to be fastest +{- +concatMap f = unstream + . Bundle.flatten mk step Unknown + . stream + where + {-# INLINE_INNER step #-} + step (v,i,k) + | i < k = case unsafeIndexM v i of + Box x -> Bundle.Yield x (v,i+1,k) + | otherwise = Bundle.Done + + {-# INLINE mk #-} + mk x = let v = f x + k = length v + in + k `seq` (v,0,k) +-} + +-- This seems to be fastest now +concatMap f = unstream + . Bundle.concatVectors + . Bundle.map f + . stream + +-- Monadic mapping +-- --------------- + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results +mapM :: (Monad m, Vector v a, Vector v b) => (a -> m b) -> v a -> m (v b) +{-# INLINE mapM #-} +mapM f = unstreamM . Bundle.mapM f . stream + +-- | /O(n)/ Apply the monadic action to every element of a vector and its +-- index, yielding a vector of results +imapM :: (Monad m, Vector v a, Vector v b) + => (Int -> a -> m b) -> v a -> m (v b) +imapM f = unstreamM . Bundle.mapM (uncurry f) . Bundle.indexed . stream + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results +mapM_ :: (Monad m, Vector v a) => (a -> m b) -> v a -> m () +{-# INLINE mapM_ #-} +mapM_ f = Bundle.mapM_ f . stream + +-- | /O(n)/ Apply the monadic action to every element of a vector and its +-- index, ignoring the results +imapM_ :: (Monad m, Vector v a) => (Int -> a -> m b) -> v a -> m () +{-# INLINE imapM_ #-} +imapM_ f = Bundle.mapM_ (uncurry f) . Bundle.indexed . stream + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results. Equivalent to @flip 'mapM'@. +forM :: (Monad m, Vector v a, Vector v b) => v a -> (a -> m b) -> m (v b) +{-# INLINE forM #-} +forM as f = mapM f as + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results. Equivalent to @flip 'mapM_'@. +forM_ :: (Monad m, Vector v a) => v a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ as f = mapM_ f as + +-- Zipping +-- ------- + +-- | /O(min(m,n))/ Zip two vectors with the given function. +zipWith :: (Vector v a, Vector v b, Vector v c) + => (a -> b -> c) -> v a -> v b -> v c +{-# INLINE zipWith #-} +zipWith f = \xs ys -> unstream (Bundle.zipWith f (stream xs) (stream ys)) + +-- | Zip three vectors with the given function. +zipWith3 :: (Vector v a, Vector v b, Vector v c, Vector v d) + => (a -> b -> c -> d) -> v a -> v b -> v c -> v d +{-# INLINE zipWith3 #-} +zipWith3 f = \as bs cs -> unstream (Bundle.zipWith3 f (stream as) + (stream bs) + (stream cs)) + +zipWith4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e) + => (a -> b -> c -> d -> e) -> v a -> v b -> v c -> v d -> v e +{-# INLINE zipWith4 #-} +zipWith4 f = \as bs cs ds -> + unstream (Bundle.zipWith4 f (stream as) + (stream bs) + (stream cs) + (stream ds)) + +zipWith5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f) + => (a -> b -> c -> d -> e -> f) -> v a -> v b -> v c -> v d -> v e + -> v f +{-# INLINE zipWith5 #-} +zipWith5 f = \as bs cs ds es -> + unstream (Bundle.zipWith5 f (stream as) + (stream bs) + (stream cs) + (stream ds) + (stream es)) + +zipWith6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f, Vector v g) + => (a -> b -> c -> d -> e -> f -> g) + -> v a -> v b -> v c -> v d -> v e -> v f -> v g +{-# INLINE zipWith6 #-} +zipWith6 f = \as bs cs ds es fs -> + unstream (Bundle.zipWith6 f (stream as) + (stream bs) + (stream cs) + (stream ds) + (stream es) + (stream fs)) + +-- | /O(min(m,n))/ Zip two vectors with a function that also takes the +-- elements' indices. +izipWith :: (Vector v a, Vector v b, Vector v c) + => (Int -> a -> b -> c) -> v a -> v b -> v c +{-# INLINE izipWith #-} +izipWith f = \xs ys -> + unstream (Bundle.zipWith (uncurry f) (Bundle.indexed (stream xs)) + (stream ys)) + +izipWith3 :: (Vector v a, Vector v b, Vector v c, Vector v d) + => (Int -> a -> b -> c -> d) -> v a -> v b -> v c -> v d +{-# INLINE izipWith3 #-} +izipWith3 f = \as bs cs -> + unstream (Bundle.zipWith3 (uncurry f) (Bundle.indexed (stream as)) + (stream bs) + (stream cs)) + +izipWith4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e) + => (Int -> a -> b -> c -> d -> e) -> v a -> v b -> v c -> v d -> v e +{-# INLINE izipWith4 #-} +izipWith4 f = \as bs cs ds -> + unstream (Bundle.zipWith4 (uncurry f) (Bundle.indexed (stream as)) + (stream bs) + (stream cs) + (stream ds)) + +izipWith5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f) + => (Int -> a -> b -> c -> d -> e -> f) -> v a -> v b -> v c -> v d + -> v e -> v f +{-# INLINE izipWith5 #-} +izipWith5 f = \as bs cs ds es -> + unstream (Bundle.zipWith5 (uncurry f) (Bundle.indexed (stream as)) + (stream bs) + (stream cs) + (stream ds) + (stream es)) + +izipWith6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f, Vector v g) + => (Int -> a -> b -> c -> d -> e -> f -> g) + -> v a -> v b -> v c -> v d -> v e -> v f -> v g +{-# INLINE izipWith6 #-} +izipWith6 f = \as bs cs ds es fs -> + unstream (Bundle.zipWith6 (uncurry f) (Bundle.indexed (stream as)) + (stream bs) + (stream cs) + (stream ds) + (stream es) + (stream fs)) + +-- | /O(min(m,n))/ Zip two vectors +zip :: (Vector v a, Vector v b, Vector v (a,b)) => v a -> v b -> v (a, b) +{-# INLINE zip #-} +zip = zipWith (,) + +zip3 :: (Vector v a, Vector v b, Vector v c, Vector v (a, b, c)) + => v a -> v b -> v c -> v (a, b, c) +{-# INLINE zip3 #-} +zip3 = zipWith3 (,,) + +zip4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v (a, b, c, d)) + => v a -> v b -> v c -> v d -> v (a, b, c, d) +{-# INLINE zip4 #-} +zip4 = zipWith4 (,,,) + +zip5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v (a, b, c, d, e)) + => v a -> v b -> v c -> v d -> v e -> v (a, b, c, d, e) +{-# INLINE zip5 #-} +zip5 = zipWith5 (,,,,) + +zip6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f, Vector v (a, b, c, d, e, f)) + => v a -> v b -> v c -> v d -> v e -> v f -> v (a, b, c, d, e, f) +{-# INLINE zip6 #-} +zip6 = zipWith6 (,,,,,) + +-- Monadic zipping +-- --------------- + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a +-- vector of results +zipWithM :: (Monad m, Vector v a, Vector v b, Vector v c) + => (a -> b -> m c) -> v a -> v b -> m (v c) +-- FIXME: specialise for ST and IO? +{-# INLINE zipWithM #-} +zipWithM f = \as bs -> unstreamM $ Bundle.zipWithM f (stream as) (stream bs) + +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes +-- the element index and yield a vector of results +izipWithM :: (Monad m, Vector v a, Vector v b, Vector v c) + => (Int -> a -> b -> m c) -> v a -> v b -> m (v c) +{-# INLINE izipWithM #-} +izipWithM m as bs = unstreamM . Bundle.zipWithM (uncurry m) + (Bundle.indexed (stream as)) + $ stream bs + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the +-- results +zipWithM_ :: (Monad m, Vector v a, Vector v b) + => (a -> b -> m c) -> v a -> v b -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ f = \as bs -> Bundle.zipWithM_ f (stream as) (stream bs) + +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes +-- the element index and ignore the results +izipWithM_ :: (Monad m, Vector v a, Vector v b) + => (Int -> a -> b -> m c) -> v a -> v b -> m () +{-# INLINE izipWithM_ #-} +izipWithM_ m as bs = Bundle.zipWithM_ (uncurry m) + (Bundle.indexed (stream as)) + $ stream bs + +-- Unzipping +-- --------- + +-- | /O(min(m,n))/ Unzip a vector of pairs. +unzip :: (Vector v a, Vector v b, Vector v (a,b)) => v (a, b) -> (v a, v b) +{-# INLINE unzip #-} +unzip xs = (map fst xs, map snd xs) + +unzip3 :: (Vector v a, Vector v b, Vector v c, Vector v (a, b, c)) + => v (a, b, c) -> (v a, v b, v c) +{-# INLINE unzip3 #-} +unzip3 xs = (map (\(a, _, _) -> a) xs, + map (\(_, b, _) -> b) xs, + map (\(_, _, c) -> c) xs) + +unzip4 :: (Vector v a, Vector v b, Vector v c, Vector v d, + Vector v (a, b, c, d)) + => v (a, b, c, d) -> (v a, v b, v c, v d) +{-# INLINE unzip4 #-} +unzip4 xs = (map (\(a, _, _, _) -> a) xs, + map (\(_, b, _, _) -> b) xs, + map (\(_, _, c, _) -> c) xs, + map (\(_, _, _, d) -> d) xs) + +unzip5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v (a, b, c, d, e)) + => v (a, b, c, d, e) -> (v a, v b, v c, v d, v e) +{-# INLINE unzip5 #-} +unzip5 xs = (map (\(a, _, _, _, _) -> a) xs, + map (\(_, b, _, _, _) -> b) xs, + map (\(_, _, c, _, _) -> c) xs, + map (\(_, _, _, d, _) -> d) xs, + map (\(_, _, _, _, e) -> e) xs) + +unzip6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f, Vector v (a, b, c, d, e, f)) + => v (a, b, c, d, e, f) -> (v a, v b, v c, v d, v e, v f) +{-# INLINE unzip6 #-} +unzip6 xs = (map (\(a, _, _, _, _, _) -> a) xs, + map (\(_, b, _, _, _, _) -> b) xs, + map (\(_, _, c, _, _, _) -> c) xs, + map (\(_, _, _, d, _, _) -> d) xs, + map (\(_, _, _, _, e, _) -> e) xs, + map (\(_, _, _, _, _, f) -> f) xs) + +-- Filtering +-- --------- + +-- | /O(n)/ Drop elements that do not satisfy the predicate +filter :: Vector v a => (a -> Bool) -> v a -> v a +{-# INLINE filter #-} +filter f = unstream . inplace (S.filter f) toMax . stream + +-- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to +-- values and their indices +ifilter :: Vector v a => (Int -> a -> Bool) -> v a -> v a +{-# INLINE ifilter #-} +ifilter f = unstream + . inplace (S.map snd . S.filter (uncurry f) . S.indexed) toMax + . stream + +-- | /O(n)/ Drop repeated adjacent elements. +uniq :: (Vector v a, Eq a) => v a -> v a +{-# INLINE uniq #-} +uniq = unstream . inplace S.uniq toMax . stream + +-- | /O(n)/ Drop elements when predicate returns Nothing +mapMaybe :: (Vector v a, Vector v b) => (a -> Maybe b) -> v a -> v b +{-# INLINE mapMaybe #-} +mapMaybe f = unstream . inplace (S.mapMaybe f) toMax . stream + +-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing +imapMaybe :: (Vector v a, Vector v b) => (Int -> a -> Maybe b) -> v a -> v b +{-# INLINE imapMaybe #-} +imapMaybe f = unstream + . inplace (S.mapMaybe (uncurry f) . S.indexed) toMax + . stream + + +-- | /O(n)/ Drop elements that do not satisfy the monadic predicate +filterM :: (Monad m, Vector v a) => (a -> m Bool) -> v a -> m (v a) +{-# INLINE filterM #-} +filterM f = unstreamM . Bundle.filterM f . stream + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate +-- without copying. +takeWhile :: Vector v a => (a -> Bool) -> v a -> v a +{-# INLINE takeWhile #-} +takeWhile f = unstream . Bundle.takeWhile f . stream + +-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate +-- without copying. +dropWhile :: Vector v a => (a -> Bool) -> v a -> v a +{-# INLINE dropWhile #-} +dropWhile f = unstream . Bundle.dropWhile f . stream + +-- Parititioning +-- ------------- + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. The +-- relative order of the elements is preserved at the cost of a sometimes +-- reduced performance compared to 'unstablePartition'. +partition :: Vector v a => (a -> Bool) -> v a -> (v a, v a) +{-# INLINE partition #-} +partition f = partition_stream f . stream + +-- FIXME: Make this inplace-fusible (look at how stable_partition is +-- implemented in C++) + +partition_stream :: Vector v a => (a -> Bool) -> Bundle u a -> (v a, v a) +{-# INLINE_FUSED partition_stream #-} +partition_stream f s = s `seq` runST ( + do + (mv1,mv2) <- M.partitionBundle f s + v1 <- unsafeFreeze mv1 + v2 <- unsafeFreeze mv2 + return (v1,v2)) + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. +-- The order of the elements is not preserved but the operation is often +-- faster than 'partition'. +unstablePartition :: Vector v a => (a -> Bool) -> v a -> (v a, v a) +{-# INLINE unstablePartition #-} +unstablePartition f = unstablePartition_stream f . stream + +unstablePartition_stream + :: Vector v a => (a -> Bool) -> Bundle u a -> (v a, v a) +{-# INLINE_FUSED unstablePartition_stream #-} +unstablePartition_stream f s = s `seq` runST ( + do + (mv1,mv2) <- M.unstablePartitionBundle f s + v1 <- unsafeFreeze mv1 + v2 <- unsafeFreeze mv2 + return (v1,v2)) + +unstablePartition_new :: Vector v a => (a -> Bool) -> New v a -> (v a, v a) +{-# INLINE_FUSED unstablePartition_new #-} +unstablePartition_new f (New.New p) = runST ( + do + mv <- p + i <- M.unstablePartition f mv + v <- unsafeFreeze mv + return (unsafeTake i v, unsafeDrop i v)) + +{-# RULES + +"unstablePartition" forall f p. + unstablePartition_stream f (stream (new p)) + = unstablePartition_new f p #-} + + + + +-- FIXME: make span and break fusible + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +span :: Vector v a => (a -> Bool) -> v a -> (v a, v a) +{-# INLINE span #-} +span f = break (not . f) + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +break :: Vector v a => (a -> Bool) -> v a -> (v a, v a) +{-# INLINE break #-} +break f xs = case findIndex f xs of + Just i -> (unsafeSlice 0 i xs, unsafeSlice i (length xs - i) xs) + Nothing -> (xs, empty) + + +-- Searching +-- --------- + +infix 4 `elem` +-- | /O(n)/ Check if the vector contains an element +elem :: (Vector v a, Eq a) => a -> v a -> Bool +{-# INLINE elem #-} +elem x = Bundle.elem x . stream + +infix 4 `notElem` +-- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') +notElem :: (Vector v a, Eq a) => a -> v a -> Bool +{-# INLINE notElem #-} +notElem x = Bundle.notElem x . stream + +-- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' +-- if no such element exists. +find :: Vector v a => (a -> Bool) -> v a -> Maybe a +{-# INLINE find #-} +find f = Bundle.find f . stream + +-- | /O(n)/ Yield 'Just' the index of the first element matching the predicate +-- or 'Nothing' if no such element exists. +findIndex :: Vector v a => (a -> Bool) -> v a -> Maybe Int +{-# INLINE findIndex #-} +findIndex f = Bundle.findIndex f . stream + +-- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending +-- order. +findIndices :: (Vector v a, Vector v Int) => (a -> Bool) -> v a -> v Int +{-# INLINE findIndices #-} +findIndices f = unstream + . inplace (S.map fst . S.filter (f . snd) . S.indexed) toMax + . stream + +-- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or +-- 'Nothing' if the vector does not contain the element. This is a specialised +-- version of 'findIndex'. +elemIndex :: (Vector v a, Eq a) => a -> v a -> Maybe Int +{-# INLINE elemIndex #-} +elemIndex x = findIndex (x==) + +-- | /O(n)/ Yield the indices of all occurences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +elemIndices :: (Vector v a, Vector v Int, Eq a) => a -> v a -> v Int +{-# INLINE elemIndices #-} +elemIndices x = findIndices (x==) + +-- Folding +-- ------- + +-- | /O(n)/ Left fold +foldl :: Vector v b => (a -> b -> a) -> a -> v b -> a +{-# INLINE foldl #-} +foldl f z = Bundle.foldl f z . stream + +-- | /O(n)/ Left fold on non-empty vectors +foldl1 :: Vector v a => (a -> a -> a) -> v a -> a +{-# INLINE foldl1 #-} +foldl1 f = Bundle.foldl1 f . stream + +-- | /O(n)/ Left fold with strict accumulator +foldl' :: Vector v b => (a -> b -> a) -> a -> v b -> a +{-# INLINE foldl' #-} +foldl' f z = Bundle.foldl' f z . stream + +-- | /O(n)/ Left fold on non-empty vectors with strict accumulator +foldl1' :: Vector v a => (a -> a -> a) -> v a -> a +{-# INLINE foldl1' #-} +foldl1' f = Bundle.foldl1' f . stream + +-- | /O(n)/ Right fold +foldr :: Vector v a => (a -> b -> b) -> b -> v a -> b +{-# INLINE foldr #-} +foldr f z = Bundle.foldr f z . stream + +-- | /O(n)/ Right fold on non-empty vectors +foldr1 :: Vector v a => (a -> a -> a) -> v a -> a +{-# INLINE foldr1 #-} +foldr1 f = Bundle.foldr1 f . stream + +-- | /O(n)/ Right fold with a strict accumulator +foldr' :: Vector v a => (a -> b -> b) -> b -> v a -> b +{-# INLINE foldr' #-} +foldr' f z = Bundle.foldl' (flip f) z . streamR + +-- | /O(n)/ Right fold on non-empty vectors with strict accumulator +foldr1' :: Vector v a => (a -> a -> a) -> v a -> a +{-# INLINE foldr1' #-} +foldr1' f = Bundle.foldl1' (flip f) . streamR + +-- | /O(n)/ Left fold (function applied to each element and its index) +ifoldl :: Vector v b => (a -> Int -> b -> a) -> a -> v b -> a +{-# INLINE ifoldl #-} +ifoldl f z = Bundle.foldl (uncurry . f) z . Bundle.indexed . stream + +-- | /O(n)/ Left fold with strict accumulator (function applied to each element +-- and its index) +ifoldl' :: Vector v b => (a -> Int -> b -> a) -> a -> v b -> a +{-# INLINE ifoldl' #-} +ifoldl' f z = Bundle.foldl' (uncurry . f) z . Bundle.indexed . stream + +-- | /O(n)/ Right fold (function applied to each element and its index) +ifoldr :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b +{-# INLINE ifoldr #-} +ifoldr f z = Bundle.foldr (uncurry f) z . Bundle.indexed . stream + +-- | /O(n)/ Right fold with strict accumulator (function applied to each +-- element and its index) +ifoldr' :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b +{-# INLINE ifoldr' #-} +ifoldr' f z xs = Bundle.foldl' (flip (uncurry f)) z + $ Bundle.indexedR (length xs) $ streamR xs + +-- Specialised folds +-- ----------------- + +-- | /O(n)/ Check if all elements satisfy the predicate. +all :: Vector v a => (a -> Bool) -> v a -> Bool +{-# INLINE all #-} +all f = Bundle.and . Bundle.map f . stream + +-- | /O(n)/ Check if any element satisfies the predicate. +any :: Vector v a => (a -> Bool) -> v a -> Bool +{-# INLINE any #-} +any f = Bundle.or . Bundle.map f . stream + +-- | /O(n)/ Check if all elements are 'True' +and :: Vector v Bool => v Bool -> Bool +{-# INLINE and #-} +and = Bundle.and . stream + +-- | /O(n)/ Check if any element is 'True' +or :: Vector v Bool => v Bool -> Bool +{-# INLINE or #-} +or = Bundle.or . stream + +-- | /O(n)/ Compute the sum of the elements +sum :: (Vector v a, Num a) => v a -> a +{-# INLINE sum #-} +sum = Bundle.foldl' (+) 0 . stream + +-- | /O(n)/ Compute the produce of the elements +product :: (Vector v a, Num a) => v a -> a +{-# INLINE product #-} +product = Bundle.foldl' (*) 1 . stream + +-- | /O(n)/ Yield the maximum element of the vector. The vector may not be +-- empty. +maximum :: (Vector v a, Ord a) => v a -> a +{-# INLINE maximum #-} +maximum = Bundle.foldl1' max . stream + +-- | /O(n)/ Yield the maximum element of the vector according to the given +-- comparison function. The vector may not be empty. +maximumBy :: Vector v a => (a -> a -> Ordering) -> v a -> a +{-# INLINE maximumBy #-} +maximumBy cmpr = Bundle.foldl1' maxBy . stream + where + {-# INLINE maxBy #-} + maxBy x y = case cmpr x y of + LT -> y + _ -> x + +-- | /O(n)/ Yield the minimum element of the vector. The vector may not be +-- empty. +minimum :: (Vector v a, Ord a) => v a -> a +{-# INLINE minimum #-} +minimum = Bundle.foldl1' min . stream + +-- | /O(n)/ Yield the minimum element of the vector according to the given +-- comparison function. The vector may not be empty. +minimumBy :: Vector v a => (a -> a -> Ordering) -> v a -> a +{-# INLINE minimumBy #-} +minimumBy cmpr = Bundle.foldl1' minBy . stream + where + {-# INLINE minBy #-} + minBy x y = case cmpr x y of + GT -> y + _ -> x + +-- | /O(n)/ Yield the index of the maximum element of the vector. The vector +-- may not be empty. +maxIndex :: (Vector v a, Ord a) => v a -> Int +{-# INLINE maxIndex #-} +maxIndex = maxIndexBy compare + +-- | /O(n)/ Yield the index of the maximum element of the vector according to +-- the given comparison function. The vector may not be empty. +maxIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int +{-# INLINE maxIndexBy #-} +maxIndexBy cmpr = fst . Bundle.foldl1' imax . Bundle.indexed . stream + where + imax (i,x) (j,y) = i `seq` j `seq` + case cmpr x y of + LT -> (j,y) + _ -> (i,x) + +-- | /O(n)/ Yield the index of the minimum element of the vector. The vector +-- may not be empty. +minIndex :: (Vector v a, Ord a) => v a -> Int +{-# INLINE minIndex #-} +minIndex = minIndexBy compare + +-- | /O(n)/ Yield the index of the minimum element of the vector according to +-- the given comparison function. The vector may not be empty. +minIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int +{-# INLINE minIndexBy #-} +minIndexBy cmpr = fst . Bundle.foldl1' imin . Bundle.indexed . stream + where + imin (i,x) (j,y) = i `seq` j `seq` + case cmpr x y of + GT -> (j,y) + _ -> (i,x) + +-- Monadic folds +-- ------------- + +-- | /O(n)/ Monadic fold +foldM :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a +{-# INLINE foldM #-} +foldM m z = Bundle.foldM m z . stream + +-- | /O(n)/ Monadic fold (action applied to each element and its index) +ifoldM :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m a +{-# INLINE ifoldM #-} +ifoldM m z = Bundle.foldM (uncurry . m) z . Bundle.indexed . stream + +-- | /O(n)/ Monadic fold over non-empty vectors +fold1M :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m a +{-# INLINE fold1M #-} +fold1M m = Bundle.fold1M m . stream + +-- | /O(n)/ Monadic fold with strict accumulator +foldM' :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a +{-# INLINE foldM' #-} +foldM' m z = Bundle.foldM' m z . stream + +-- | /O(n)/ Monadic fold with strict accumulator (action applied to each +-- element and its index) +ifoldM' :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m a +{-# INLINE ifoldM' #-} +ifoldM' m z = Bundle.foldM' (uncurry . m) z . Bundle.indexed . stream + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +fold1M' :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m a +{-# INLINE fold1M' #-} +fold1M' m = Bundle.fold1M' m . stream + +discard :: Monad m => m a -> m () +{-# INLINE discard #-} +discard m = m >> return () + +-- | /O(n)/ Monadic fold that discards the result +foldM_ :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m () +{-# INLINE foldM_ #-} +foldM_ m z = discard . Bundle.foldM m z . stream + +-- | /O(n)/ Monadic fold that discards the result (action applied to +-- each element and its index) +ifoldM_ :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m () +{-# INLINE ifoldM_ #-} +ifoldM_ m z = discard . Bundle.foldM (uncurry . m) z . Bundle.indexed . stream + +-- | /O(n)/ Monadic fold over non-empty vectors that discards the result +fold1M_ :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m () +{-# INLINE fold1M_ #-} +fold1M_ m = discard . Bundle.fold1M m . stream + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +foldM'_ :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m () +{-# INLINE foldM'_ #-} +foldM'_ m z = discard . Bundle.foldM' m z . stream + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +-- (action applied to each element and its index) +ifoldM'_ :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m () +{-# INLINE ifoldM'_ #-} +ifoldM'_ m z = discard . Bundle.foldM' (uncurry . m) z . Bundle.indexed . stream + +-- | /O(n)/ Monad fold over non-empty vectors with strict accumulator +-- that discards the result +fold1M'_ :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ m = discard . Bundle.fold1M' m . stream + +-- Monadic sequencing +-- ------------------ + +-- | Evaluate each action and collect the results +sequence :: (Monad m, Vector v a, Vector v (m a)) => v (m a) -> m (v a) +{-# INLINE sequence #-} +sequence = mapM id + +-- | Evaluate each action and discard the results +sequence_ :: (Monad m, Vector v (m a)) => v (m a) -> m () +{-# INLINE sequence_ #-} +sequence_ = mapM_ id + +-- Prefix sums (scans) +-- ------------------- + +-- | /O(n)/ Prescan +-- +-- @ +-- prescanl f z = 'init' . 'scanl' f z +-- @ +-- +-- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ +-- +prescanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a +{-# INLINE prescanl #-} +prescanl f z = unstream . inplace (S.prescanl f z) id . stream + +-- | /O(n)/ Prescan with strict accumulator +prescanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a +{-# INLINE prescanl' #-} +prescanl' f z = unstream . inplace (S.prescanl' f z) id . stream + +-- | /O(n)/ Scan +-- +-- @ +-- postscanl f z = 'tail' . 'scanl' f z +-- @ +-- +-- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ +-- +postscanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a +{-# INLINE postscanl #-} +postscanl f z = unstream . inplace (S.postscanl f z) id . stream + +-- | /O(n)/ Scan with strict accumulator +postscanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a +{-# INLINE postscanl' #-} +postscanl' f z = unstream . inplace (S.postscanl' f z) id . stream + +-- | /O(n)/ Haskell-style scan +-- +-- > scanl f z <x1,...,xn> = <y1,...,y(n+1)> +-- > where y1 = z +-- > yi = f y(i-1) x(i-1) +-- +-- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@ +-- +scanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a +{-# INLINE scanl #-} +scanl f z = unstream . Bundle.scanl f z . stream + +-- | /O(n)/ Haskell-style scan with strict accumulator +scanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a +{-# INLINE scanl' #-} +scanl' f z = unstream . Bundle.scanl' f z . stream + +-- | /O(n)/ Scan over a vector with its index +iscanl :: (Vector v a, Vector v b) => (Int -> a -> b -> a) -> a -> v b -> v a +{-# INLINE iscanl #-} +iscanl f z = + unstream + . inplace (S.scanl (\a (i, b) -> f i a b) z . S.indexed) (+1) + . stream + +-- | /O(n)/ Scan over a vector (strictly) with its index +iscanl' :: (Vector v a, Vector v b) => (Int -> a -> b -> a) -> a -> v b -> v a +{-# INLINE iscanl' #-} +iscanl' f z = + unstream + . inplace (S.scanl' (\a (i, b) -> f i a b) z . S.indexed) (+1) + . stream + + +-- | /O(n)/ Scan over a non-empty vector +-- +-- > scanl f <x1,...,xn> = <y1,...,yn> +-- > where y1 = x1 +-- > yi = f y(i-1) xi +-- +scanl1 :: Vector v a => (a -> a -> a) -> v a -> v a +{-# INLINE scanl1 #-} +scanl1 f = unstream . inplace (S.scanl1 f) id . stream + +-- | /O(n)/ Scan over a non-empty vector with a strict accumulator +scanl1' :: Vector v a => (a -> a -> a) -> v a -> v a +{-# INLINE scanl1' #-} +scanl1' f = unstream . inplace (S.scanl1' f) id . stream + +-- | /O(n)/ Right-to-left prescan +-- +-- @ +-- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' +-- @ +-- +prescanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b +{-# INLINE prescanr #-} +prescanr f z = unstreamR . inplace (S.prescanl (flip f) z) id . streamR + +-- | /O(n)/ Right-to-left prescan with strict accumulator +prescanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b +{-# INLINE prescanr' #-} +prescanr' f z = unstreamR . inplace (S.prescanl' (flip f) z) id . streamR + +-- | /O(n)/ Right-to-left scan +postscanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b +{-# INLINE postscanr #-} +postscanr f z = unstreamR . inplace (S.postscanl (flip f) z) id . streamR + +-- | /O(n)/ Right-to-left scan with strict accumulator +postscanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b +{-# INLINE postscanr' #-} +postscanr' f z = unstreamR . inplace (S.postscanl' (flip f) z) id . streamR + +-- | /O(n)/ Right-to-left Haskell-style scan +scanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b +{-# INLINE scanr #-} +scanr f z = unstreamR . Bundle.scanl (flip f) z . streamR + +-- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator +scanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b +{-# INLINE scanr' #-} +scanr' f z = unstreamR . Bundle.scanl' (flip f) z . streamR + +-- | /O(n)/ Right-to-left scan over a vector with its index +iscanr :: (Vector v a, Vector v b) => (Int -> a -> b -> b) -> b -> v a -> v b +{-# INLINE iscanr #-} +iscanr f z v = + unstreamR + . inplace (S.scanl (flip $ uncurry f) z . S.indexedR n) (+1) + . streamR + $ v + where n = length v + +-- | /O(n)/ Right-to-left scan over a vector (strictly) with its index +iscanr' :: (Vector v a, Vector v b) => (Int -> a -> b -> b) -> b -> v a -> v b +{-# INLINE iscanr' #-} +iscanr' f z v = + unstreamR + . inplace (S.scanl' (flip $ uncurry f) z . S.indexedR n) (+1) + . streamR + $ v + where n = length v + +-- | /O(n)/ Right-to-left scan over a non-empty vector +scanr1 :: Vector v a => (a -> a -> a) -> v a -> v a +{-# INLINE scanr1 #-} +scanr1 f = unstreamR . inplace (S.scanl1 (flip f)) id . streamR + +-- | /O(n)/ Right-to-left scan over a non-empty vector with a strict +-- accumulator +scanr1' :: Vector v a => (a -> a -> a) -> v a -> v a +{-# INLINE scanr1' #-} +scanr1' f = unstreamR . inplace (S.scanl1' (flip f)) id . streamR + +-- Conversions - Lists +-- ------------------------ + +-- | /O(n)/ Convert a vector to a list +toList :: Vector v a => v a -> [a] +{-# INLINE toList #-} +toList = Bundle.toList . stream + +-- | /O(n)/ Convert a list to a vector +fromList :: Vector v a => [a] -> v a +{-# INLINE fromList #-} +fromList = unstream . Bundle.fromList + +-- | /O(n)/ Convert the first @n@ elements of a list to a vector +-- +-- @ +-- fromListN n xs = 'fromList' ('take' n xs) +-- @ +fromListN :: Vector v a => Int -> [a] -> v a +{-# INLINE fromListN #-} +fromListN n = unstream . Bundle.fromListN n + +-- Conversions - Immutable vectors +-- ------------------------------- + +-- | /O(n)/ Convert different vector types +convert :: (Vector v a, Vector w a) => v a -> w a +{-# INLINE convert #-} +convert = unstream . Bundle.reVector . stream + +-- Conversions - Mutable vectors +-- ----------------------------- + +-- | /O(1)/ Unsafe convert a mutable vector to an immutable one without +-- copying. The mutable vector may not be used after this operation. +unsafeFreeze + :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m (v a) +{-# INLINE unsafeFreeze #-} +unsafeFreeze = basicUnsafeFreeze + +-- | /O(n)/ Yield an immutable copy of the mutable vector. +freeze :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m (v a) +{-# INLINE freeze #-} +freeze mv = unsafeFreeze =<< M.clone mv + +-- | /O(1)/ Unsafely convert an immutable vector to a mutable one without +-- copying. The immutable vector may not be used after this operation. +unsafeThaw :: (PrimMonad m, Vector v a) => v a -> m (Mutable v (PrimState m) a) +{-# INLINE_FUSED unsafeThaw #-} +unsafeThaw = basicUnsafeThaw + +-- | /O(n)/ Yield a mutable copy of the immutable vector. +thaw :: (PrimMonad m, Vector v a) => v a -> m (Mutable v (PrimState m) a) +{-# INLINE_FUSED thaw #-} +thaw v = do + mv <- M.unsafeNew (length v) + unsafeCopy mv v + return mv + +{-# RULES + +"unsafeThaw/new [Vector]" forall p. + unsafeThaw (new p) = New.runPrim p + +"thaw/new [Vector]" forall p. + thaw (new p) = New.runPrim p #-} + + + +{- +-- | /O(n)/ Yield a mutable vector containing copies of each vector in the +-- list. +thawMany :: (PrimMonad m, Vector v a) => [v a] -> m (Mutable v (PrimState m) a) +{-# INLINE_FUSED thawMany #-} +-- FIXME: add rule for (stream (new (New.create (thawMany vs)))) +-- NOTE: We don't try to consume the list lazily as this wouldn't significantly +-- change the space requirements anyway. +thawMany vs = do + mv <- M.new n + thaw_loop mv vs + return mv + where + n = List.foldl' (\k v -> k + length v) 0 vs + + thaw_loop mv [] = mv `seq` return () + thaw_loop mv (v:vs) + = do + let n = length v + unsafeCopy (M.unsafeTake n mv) v + thaw_loop (M.unsafeDrop n mv) vs +-} + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. +copy + :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> v a -> m () +{-# INLINE copy #-} +copy dst src = BOUNDS_CHECK(check) "copy" "length mismatch" + (M.length dst == length src) + $ unsafeCopy dst src + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. This is not checked. +unsafeCopy + :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> v a -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy dst src = UNSAFE_CHECK(check) "unsafeCopy" "length mismatch" + (M.length dst == length src) + $ (dst `seq` src `seq` basicUnsafeCopy dst src) + +-- Conversions to/from Bundles +-- --------------------------- + +-- | /O(1)/ Convert a vector to a 'Bundle' +stream :: Vector v a => v a -> Bundle v a +{-# INLINE_FUSED stream #-} +stream v = stream' v + +-- Same as 'stream', but can be used to avoid having a cycle in the dependency +-- graph of functions, which forces GHC to create a loop breaker. +stream' :: Vector v a => v a -> Bundle v a +{-# INLINE stream' #-} +stream' v = Bundle.fromVector v + +{- +stream v = v `seq` n `seq` (Bundle.unfoldr get 0 `Bundle.sized` Exact n) + where + n = length v + + -- NOTE: the False case comes first in Core so making it the recursive one + -- makes the code easier to read + {-# INLINE get #-} + get i | i >= n = Nothing + | otherwise = case basicUnsafeIndexM v i of Box x -> Just (x, i+1) +-} + +-- | /O(n)/ Construct a vector from a 'Bundle' +unstream :: Vector v a => Bundle v a -> v a +{-# INLINE unstream #-} +unstream s = new (New.unstream s) + +{-# RULES + +"stream/unstream [Vector]" forall s. + stream (new (New.unstream s)) = s + +"New.unstream/stream [Vector]" forall v. + New.unstream (stream v) = clone v + +"clone/new [Vector]" forall p. + clone (new p) = p + +"inplace [Vector]" + forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m. + New.unstream (inplace f g (stream (new m))) = New.transform f g m + +"uninplace [Vector]" + forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m. + stream (new (New.transform f g m)) = inplace f g (stream (new m)) #-} + + + +-- | /O(1)/ Convert a vector to a 'Bundle', proceeding from right to left +streamR :: Vector v a => v a -> Bundle u a +{-# INLINE_FUSED streamR #-} +streamR v = v `seq` n `seq` (Bundle.unfoldr get n `Bundle.sized` Exact n) + where + n = length v + + {-# INLINE get #-} + get 0 = Nothing + get i = let i' = i-1 + in + case basicUnsafeIndexM v i' of Box x -> Just (x, i') + +-- | /O(n)/ Construct a vector from a 'Bundle', proceeding from right to left +unstreamR :: Vector v a => Bundle v a -> v a +{-# INLINE unstreamR #-} +unstreamR s = new (New.unstreamR s) + +{-# RULES + +"streamR/unstreamR [Vector]" forall s. + streamR (new (New.unstreamR s)) = s + +"New.unstreamR/streamR/new [Vector]" forall p. + New.unstreamR (streamR (new p)) = p + +"New.unstream/streamR/new [Vector]" forall p. + New.unstream (streamR (new p)) = New.modify M.reverse p + +"New.unstreamR/stream/new [Vector]" forall p. + New.unstreamR (stream (new p)) = New.modify M.reverse p + +"inplace right [Vector]" + forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m. + New.unstreamR (inplace f g (streamR (new m))) = New.transformR f g m + +"uninplace right [Vector]" + forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m. + streamR (new (New.transformR f g m)) = inplace f g (streamR (new m)) #-} + + + +unstreamM :: (Monad m, Vector v a) => MBundle m u a -> m (v a) +{-# INLINE_FUSED unstreamM #-} +unstreamM s = do + xs <- MBundle.toList s + return $ unstream $ Bundle.unsafeFromList (MBundle.size s) xs + +unstreamPrimM :: (PrimMonad m, Vector v a) => MBundle m u a -> m (v a) +{-# INLINE_FUSED unstreamPrimM #-} +unstreamPrimM s = M.munstream s >>= unsafeFreeze + +-- FIXME: the next two functions are only necessary for the specialisations +unstreamPrimM_IO :: Vector v a => MBundle IO u a -> IO (v a) +{-# INLINE unstreamPrimM_IO #-} +unstreamPrimM_IO = unstreamPrimM + +unstreamPrimM_ST :: Vector v a => MBundle (ST s) u a -> ST s (v a) +{-# INLINE unstreamPrimM_ST #-} +unstreamPrimM_ST = unstreamPrimM + +{-# RULES + +"unstreamM[IO]" unstreamM = unstreamPrimM_IO +"unstreamM[ST]" unstreamM = unstreamPrimM_ST #-} + + + + +-- Recycling support +-- ----------------- + +-- | Construct a vector from a monadic initialiser. +new :: Vector v a => New v a -> v a +{-# INLINE_FUSED new #-} +new m = m `seq` runST (unsafeFreeze =<< New.run m) + +-- | Convert a vector to an initialiser which, when run, produces a copy of +-- the vector. +clone :: Vector v a => v a -> New v a +{-# INLINE_FUSED clone #-} +clone v = v `seq` New.create ( + do + mv <- M.new (length v) + unsafeCopy mv v + return mv) + +-- Comparisons +-- ----------- + +-- | /O(n)/ Check if two vectors are equal. All 'Vector' instances are also +-- instances of 'Eq' and it is usually more appropriate to use those. This +-- function is primarily intended for implementing 'Eq' instances for new +-- vector types. +eq :: (Vector v a, Eq a) => v a -> v a -> Bool +{-# INLINE eq #-} +xs `eq` ys = stream xs == stream ys + +-- | /O(n)/ +eqBy :: (Vector v a, Vector v b) => (a -> b -> Bool) -> v a -> v b -> Bool +{-# INLINE eqBy #-} +eqBy e xs ys = Bundle.eqBy e (stream xs) (stream ys) + +-- | /O(n)/ Compare two vectors lexicographically. All 'Vector' instances are +-- also instances of 'Ord' and it is usually more appropriate to use those. This +-- function is primarily intended for implementing 'Ord' instances for new +-- vector types. +cmp :: (Vector v a, Ord a) => v a -> v a -> Ordering +{-# INLINE cmp #-} +cmp xs ys = compare (stream xs) (stream ys) + +-- | /O(n)/ +cmpBy :: (Vector v a, Vector v b) => (a -> b -> Ordering) -> v a -> v b -> Ordering +cmpBy c xs ys = Bundle.cmpBy c (stream xs) (stream ys) + +-- Show +-- ---- + +-- | Generic definition of 'Prelude.showsPrec' +showsPrec :: (Vector v a, Show a) => Int -> v a -> ShowS +{-# INLINE showsPrec #-} +showsPrec _ = shows . toList + +liftShowsPrec :: (Vector v a) => (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> v a -> ShowS +{-# INLINE liftShowsPrec #-} +liftShowsPrec _ s _ = s . toList + +-- | Generic definition of 'Text.Read.readPrec' +readPrec :: (Vector v a, Read a) => Read.ReadPrec (v a) +{-# INLINE readPrec #-} +readPrec = do + xs <- Read.readPrec + return (fromList xs) + +-- | /Note:/ uses 'ReadS' +liftReadsPrec :: (Vector v a) => (Int -> Read.ReadS a) -> ReadS [a] -> Int -> Read.ReadS (v a) +liftReadsPrec _ r _ s = [ (fromList v, s') | (v, s') <- r s ] + +-- Data and Typeable +-- ----------------- + +-- | Generic definion of 'Data.Data.gfoldl' that views a 'Vector' as a +-- list. +gfoldl :: (Vector v a, Data a) + => (forall d b. Data d => c (d -> b) -> d -> c b) + -> (forall g. g -> c g) + -> v a + -> c (v a) +{-# INLINE gfoldl #-} +gfoldl f z v = z fromList `f` toList v + +mkType :: String -> DataType +{-# INLINE mkType #-} +mkType = mkNoRepType + +#if __GLASGOW_HASKELL__ >= 707 +dataCast :: (Vector v a, Data a, Typeable v, Typeable t) +#else +dataCast :: (Vector v a, Data a, Typeable1 v, Typeable1 t) +#endif + => (forall d. Data d => c (t d)) -> Maybe (c (v a)) +{-# INLINE dataCast #-} +dataCast f = gcast1 f diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Base.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Base.hs new file mode 100644 index 0000000000..a760329c59 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Base.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleContexts, + TypeFamilies, ScopedTypeVariables, BangPatterns #-} +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Module : Data.Vector.Generic.Base +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Class of pure vectors +-- + +module Data.Vector.Generic.Base ( + Vector(..), Mutable +) where + +import Data.Vector.Generic.Mutable.Base ( MVector ) +import qualified Data.Vector.Generic.Mutable.Base as M + +import Control.Monad.Primitive + +-- | @Mutable v s a@ is the mutable version of the pure vector type @v a@ with +-- the state token @s@ +-- +type family Mutable (v :: * -> *) :: * -> * -> * + +-- | Class of immutable vectors. Every immutable vector is associated with its +-- mutable version through the 'Mutable' type family. Methods of this class +-- should not be used directly. Instead, "Data.Vector.Generic" and other +-- Data.Vector modules provide safe and fusible wrappers. +-- +-- Minimum complete implementation: +-- +-- * 'basicUnsafeFreeze' +-- +-- * 'basicUnsafeThaw' +-- +-- * 'basicLength' +-- +-- * 'basicUnsafeSlice' +-- +-- * 'basicUnsafeIndexM' +-- +class MVector (Mutable v) a => Vector v a where + -- | /Assumed complexity: O(1)/ + -- + -- Unsafely convert a mutable vector to its immutable version + -- without copying. The mutable vector may not be used after + -- this operation. + basicUnsafeFreeze :: PrimMonad m => Mutable v (PrimState m) a -> m (v a) + + -- | /Assumed complexity: O(1)/ + -- + -- Unsafely convert an immutable vector to its mutable version without + -- copying. The immutable vector may not be used after this operation. + basicUnsafeThaw :: PrimMonad m => v a -> m (Mutable v (PrimState m) a) + + -- | /Assumed complexity: O(1)/ + -- + -- Yield the length of the vector. + basicLength :: v a -> Int + + -- | /Assumed complexity: O(1)/ + -- + -- Yield a slice of the vector without copying it. No range checks are + -- performed. + basicUnsafeSlice :: Int -- ^ starting index + -> Int -- ^ length + -> v a -> v a + + -- | /Assumed complexity: O(1)/ + -- + -- Yield the element at the given position in a monad. No range checks are + -- performed. + -- + -- The monad allows us to be strict in the vector if we want. Suppose we had + -- + -- > unsafeIndex :: v a -> Int -> a + -- + -- instead. Now, if we wanted to copy a vector, we'd do something like + -- + -- > copy mv v ... = ... unsafeWrite mv i (unsafeIndex v i) ... + -- + -- For lazy vectors, the indexing would not be evaluated which means that we + -- would retain a reference to the original vector in each element we write. + -- This is not what we want! + -- + -- With 'basicUnsafeIndexM', we can do + -- + -- > copy mv v ... = ... case basicUnsafeIndexM v i of + -- > Box x -> unsafeWrite mv i x ... + -- + -- which does not have this problem because indexing (but not the returned + -- element!) is evaluated immediately. + -- + basicUnsafeIndexM :: Monad m => v a -> Int -> m a + + -- | /Assumed complexity: O(n)/ + -- + -- Copy an immutable vector into a mutable one. The two vectors must have + -- the same length but this is not checked. + -- + -- Instances of 'Vector' should redefine this method if they wish to support + -- an efficient block copy operation. + -- + -- Default definition: copying basic on 'basicUnsafeIndexM' and + -- 'basicUnsafeWrite'. + basicUnsafeCopy :: PrimMonad m => Mutable v (PrimState m) a -> v a -> m () + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy !dst !src = do_copy 0 + where + !n = basicLength src + + do_copy i | i < n = do + x <- basicUnsafeIndexM src i + M.basicUnsafeWrite dst i x + do_copy (i+1) + | otherwise = return () + + -- | Evaluate @a@ as far as storing it in a vector would and yield @b@. + -- The @v a@ argument only fixes the type and is not touched. The method is + -- only used for optimisation purposes. Thus, it is safe for instances of + -- 'Vector' to evaluate @a@ less than it would be when stored in a vector + -- although this might result in suboptimal code. + -- + -- > elemseq v x y = (singleton x `asTypeOf` v) `seq` y + -- + -- Default defintion: @a@ is not evaluated at all + -- + elemseq :: v a -> a -> b -> b + + {-# INLINE elemseq #-} + elemseq _ = \_ x -> x + + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable.hs new file mode 100644 index 0000000000..89bebf3607 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable.hs @@ -0,0 +1,1034 @@ +{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleContexts, BangPatterns, TypeFamilies, ScopedTypeVariables #-} +-- | +-- Module : Data.Vector.Generic.Mutable +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Generic interface to mutable vectors +-- + +module Data.Vector.Generic.Mutable ( + -- * Class of mutable vector types + MVector(..), + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, clone, + + -- ** Growing + grow, unsafeGrow, + growFront, unsafeGrowFront, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, write, modify, swap, exchange, + unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, unsafeExchange, + + -- * Modifying vectors + nextPermutation, + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove, + + -- * Internal operations + mstream, mstreamR, + unstream, unstreamR, vunstream, + munstream, munstreamR, + transform, transformR, + fill, fillR, + unsafeAccum, accum, unsafeUpdate, update, reverse, + unstablePartition, unstablePartitionBundle, partitionBundle +) where + +import Data.Vector.Generic.Mutable.Base +import qualified Data.Vector.Generic.Base as V + +import qualified Data.Vector.Fusion.Bundle as Bundle +import Data.Vector.Fusion.Bundle ( Bundle, MBundle, Chunk(..) ) +import qualified Data.Vector.Fusion.Bundle.Monadic as MBundle +import Data.Vector.Fusion.Stream.Monadic ( Stream ) +import qualified Data.Vector.Fusion.Stream.Monadic as Stream +import Data.Vector.Fusion.Bundle.Size +import Data.Vector.Fusion.Util ( delay_inline ) + +import Control.Monad.Primitive ( PrimMonad, PrimState ) + +import Prelude hiding ( length, null, replicate, reverse, map, read, + take, drop, splitAt, init, tail ) + +#include "vector.h" + +{- +type family Immutable (v :: * -> * -> *) :: * -> * + +-- | Class of mutable vectors parametrised with a primitive state token. +-- +class MBundle.Pointer u a => MVector v a where + -- | Length of the mutable vector. This method should not be + -- called directly, use 'length' instead. + basicLength :: v s a -> Int + + -- | Yield a part of the mutable vector without copying it. This method + -- should not be called directly, use 'unsafeSlice' instead. + basicUnsafeSlice :: Int -- ^ starting index + -> Int -- ^ length of the slice + -> v s a + -> v s a + + -- Check whether two vectors overlap. This method should not be + -- called directly, use 'overlaps' instead. + basicOverlaps :: v s a -> v s a -> Bool + + -- | Create a mutable vector of the given length. This method should not be + -- called directly, use 'unsafeNew' instead. + basicUnsafeNew :: PrimMonad m => Int -> m (v (PrimState m) a) + + -- | Create a mutable vector of the given length and fill it with an + -- initial value. This method should not be called directly, use + -- 'replicate' instead. + basicUnsafeReplicate :: PrimMonad m => Int -> a -> m (v (PrimState m) a) + + -- | Yield the element at the given position. This method should not be + -- called directly, use 'unsafeRead' instead. + basicUnsafeRead :: PrimMonad m => v (PrimState m) a -> Int -> m a + + -- | Replace the element at the given position. This method should not be + -- called directly, use 'unsafeWrite' instead. + basicUnsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m () + + -- | Reset all elements of the vector to some undefined value, clearing all + -- references to external objects. This is usually a noop for unboxed + -- vectors. This method should not be called directly, use 'clear' instead. + basicClear :: PrimMonad m => v (PrimState m) a -> m () + + -- | Set all elements of the vector to the given value. This method should + -- not be called directly, use 'set' instead. + basicSet :: PrimMonad m => v (PrimState m) a -> a -> m () + + basicUnsafeCopyPointer :: PrimMonad m => v (PrimState m) a + -> Immutable v a + -> m () + + -- | Copy a vector. The two vectors may not overlap. This method should not + -- be called directly, use 'unsafeCopy' instead. + basicUnsafeCopy :: PrimMonad m => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () + + -- | Move the contents of a vector. The two vectors may overlap. This method + -- should not be called directly, use 'unsafeMove' instead. + basicUnsafeMove :: PrimMonad m => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () + + -- | Grow a vector by the given number of elements. This method should not be + -- called directly, use 'unsafeGrow' instead. + basicUnsafeGrow :: PrimMonad m => v (PrimState m) a -> Int + -> m (v (PrimState m) a) + + {-# INLINE basicUnsafeReplicate #-} + basicUnsafeReplicate n x + = do + v <- basicUnsafeNew n + basicSet v x + return v + + {-# INLINE basicClear #-} + basicClear _ = return () + + {-# INLINE basicSet #-} + basicSet !v x + | n == 0 = return () + | otherwise = do + basicUnsafeWrite v 0 x + do_set 1 + where + !n = basicLength v + + do_set i | 2*i < n = do basicUnsafeCopy (basicUnsafeSlice i i v) + (basicUnsafeSlice 0 i v) + do_set (2*i) + | otherwise = basicUnsafeCopy (basicUnsafeSlice i (n-i) v) + (basicUnsafeSlice 0 (n-i) v) + + {-# INLINE basicUnsafeCopyPointer #-} + basicUnsafeCopyPointer !dst !src = do_copy 0 src + where + do_copy !i p | Just (x,q) <- MBundle.pget p = do + basicUnsafeWrite dst i x + do_copy (i+1) q + | otherwise = return () + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy !dst !src = do_copy 0 + where + !n = basicLength src + + do_copy i | i < n = do + x <- basicUnsafeRead src i + basicUnsafeWrite dst i x + do_copy (i+1) + | otherwise = return () + + {-# INLINE basicUnsafeMove #-} + basicUnsafeMove !dst !src + | basicOverlaps dst src = do + srcCopy <- clone src + basicUnsafeCopy dst srcCopy + | otherwise = basicUnsafeCopy dst src + + {-# INLINE basicUnsafeGrow #-} + basicUnsafeGrow v by + = do + v' <- basicUnsafeNew (n+by) + basicUnsafeCopy (basicUnsafeSlice 0 n v') v + return v' + where + n = basicLength v +-} + +-- ------------------ +-- Internal functions +-- ------------------ + +unsafeAppend1 :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> a -> m (v (PrimState m) a) +{-# INLINE_INNER unsafeAppend1 #-} + -- NOTE: The case distinction has to be on the outside because + -- GHC creates a join point for the unsafeWrite even when everything + -- is inlined. This is bad because with the join point, v isn't getting + -- unboxed. +unsafeAppend1 v i x + | i < length v = do + unsafeWrite v i x + return v + | otherwise = do + v' <- enlarge v + INTERNAL_CHECK(checkIndex) "unsafeAppend1" i (length v') + $ unsafeWrite v' i x + return v' + +unsafePrepend1 :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> a -> m (v (PrimState m) a, Int) +{-# INLINE_INNER unsafePrepend1 #-} +unsafePrepend1 v i x + | i /= 0 = do + let i' = i-1 + unsafeWrite v i' x + return (v, i') + | otherwise = do + (v', j) <- enlargeFront v + let i' = j-1 + INTERNAL_CHECK(checkIndex) "unsafePrepend1" i' (length v') + $ unsafeWrite v' i' x + return (v', i') + +mstream :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Stream m a +{-# INLINE mstream #-} +mstream v = v `seq` n `seq` (Stream.unfoldrM get 0) + where + n = length v + + {-# INLINE_INNER get #-} + get i | i < n = do x <- unsafeRead v i + return $ Just (x, i+1) + | otherwise = return $ Nothing + +fill :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Stream m a -> m (v (PrimState m) a) +{-# INLINE fill #-} +fill v s = v `seq` do + n' <- Stream.foldM put 0 s + return $ unsafeSlice 0 n' v + where + {-# INLINE_INNER put #-} + put i x = do + INTERNAL_CHECK(checkIndex) "fill" i (length v) + $ unsafeWrite v i x + return (i+1) + +transform + :: (PrimMonad m, MVector v a) + => (Stream m a -> Stream m a) -> v (PrimState m) a -> m (v (PrimState m) a) +{-# INLINE_FUSED transform #-} +transform f v = fill v (f (mstream v)) + +mstreamR :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Stream m a +{-# INLINE mstreamR #-} +mstreamR v = v `seq` n `seq` (Stream.unfoldrM get n) + where + n = length v + + {-# INLINE_INNER get #-} + get i | j >= 0 = do x <- unsafeRead v j + return $ Just (x,j) + | otherwise = return Nothing + where + j = i-1 + +fillR :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Stream m a -> m (v (PrimState m) a) +{-# INLINE fillR #-} +fillR v s = v `seq` do + i <- Stream.foldM put n s + return $ unsafeSlice i (n-i) v + where + n = length v + + {-# INLINE_INNER put #-} + put i x = do + unsafeWrite v j x + return j + where + j = i-1 + +transformR + :: (PrimMonad m, MVector v a) + => (Stream m a -> Stream m a) -> v (PrimState m) a -> m (v (PrimState m) a) +{-# INLINE_FUSED transformR #-} +transformR f v = fillR v (f (mstreamR v)) + +-- | Create a new mutable vector and fill it with elements from the 'Bundle'. +-- The vector will grow exponentially if the maximum size of the 'Bundle' is +-- unknown. +unstream :: (PrimMonad m, MVector v a) + => Bundle u a -> m (v (PrimState m) a) +-- NOTE: replace INLINE_FUSED by INLINE? (also in unstreamR) +{-# INLINE_FUSED unstream #-} +unstream s = munstream (Bundle.lift s) + +-- | Create a new mutable vector and fill it with elements from the monadic +-- stream. The vector will grow exponentially if the maximum size of the stream +-- is unknown. +munstream :: (PrimMonad m, MVector v a) + => MBundle m u a -> m (v (PrimState m) a) +{-# INLINE_FUSED munstream #-} +munstream s = case upperBound (MBundle.size s) of + Just n -> munstreamMax s n + Nothing -> munstreamUnknown s + +-- FIXME: I can't think of how to prevent GHC from floating out +-- unstreamUnknown. That is bad because SpecConstr then generates two +-- specialisations: one for when it is called from unstream (it doesn't know +-- the shape of the vector) and one for when the vector has grown. To see the +-- problem simply compile this: +-- +-- fromList = Data.Vector.Unboxed.unstream . Bundle.fromList +-- +-- I'm not sure this still applies (19/04/2010) + +munstreamMax :: (PrimMonad m, MVector v a) + => MBundle m u a -> Int -> m (v (PrimState m) a) +{-# INLINE munstreamMax #-} +munstreamMax s n + = do + v <- INTERNAL_CHECK(checkLength) "munstreamMax" n + $ unsafeNew n + let put i x = do + INTERNAL_CHECK(checkIndex) "munstreamMax" i n + $ unsafeWrite v i x + return (i+1) + n' <- MBundle.foldM' put 0 s + return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n + $ unsafeSlice 0 n' v + +munstreamUnknown :: (PrimMonad m, MVector v a) + => MBundle m u a -> m (v (PrimState m) a) +{-# INLINE munstreamUnknown #-} +munstreamUnknown s + = do + v <- unsafeNew 0 + (v', n) <- MBundle.foldM put (v, 0) s + return $ INTERNAL_CHECK(checkSlice) "munstreamUnknown" 0 n (length v') + $ unsafeSlice 0 n v' + where + {-# INLINE_INNER put #-} + put (v,i) x = do + v' <- unsafeAppend1 v i x + return (v',i+1) + + + + + + + +-- | Create a new mutable vector and fill it with elements from the 'Bundle'. +-- The vector will grow exponentially if the maximum size of the 'Bundle' is +-- unknown. +vunstream :: (PrimMonad m, V.Vector v a) + => Bundle v a -> m (V.Mutable v (PrimState m) a) +-- NOTE: replace INLINE_FUSED by INLINE? (also in unstreamR) +{-# INLINE_FUSED vunstream #-} +vunstream s = vmunstream (Bundle.lift s) + +-- | Create a new mutable vector and fill it with elements from the monadic +-- stream. The vector will grow exponentially if the maximum size of the stream +-- is unknown. +vmunstream :: (PrimMonad m, V.Vector v a) + => MBundle m v a -> m (V.Mutable v (PrimState m) a) +{-# INLINE_FUSED vmunstream #-} +vmunstream s = case upperBound (MBundle.size s) of + Just n -> vmunstreamMax s n + Nothing -> vmunstreamUnknown s + +-- FIXME: I can't think of how to prevent GHC from floating out +-- unstreamUnknown. That is bad because SpecConstr then generates two +-- specialisations: one for when it is called from unstream (it doesn't know +-- the shape of the vector) and one for when the vector has grown. To see the +-- problem simply compile this: +-- +-- fromList = Data.Vector.Unboxed.unstream . Bundle.fromList +-- +-- I'm not sure this still applies (19/04/2010) + +vmunstreamMax :: (PrimMonad m, V.Vector v a) + => MBundle m v a -> Int -> m (V.Mutable v (PrimState m) a) +{-# INLINE vmunstreamMax #-} +vmunstreamMax s n + = do + v <- INTERNAL_CHECK(checkLength) "munstreamMax" n + $ unsafeNew n + let {-# INLINE_INNER copyChunk #-} + copyChunk i (Chunk m f) = + INTERNAL_CHECK(checkSlice) "munstreamMax.copyChunk" i m (length v) $ do + f (basicUnsafeSlice i m v) + return (i+m) + + n' <- Stream.foldlM' copyChunk 0 (MBundle.chunks s) + return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n + $ unsafeSlice 0 n' v + +vmunstreamUnknown :: (PrimMonad m, V.Vector v a) + => MBundle m v a -> m (V.Mutable v (PrimState m) a) +{-# INLINE vmunstreamUnknown #-} +vmunstreamUnknown s + = do + v <- unsafeNew 0 + (v', n) <- Stream.foldlM copyChunk (v,0) (MBundle.chunks s) + return $ INTERNAL_CHECK(checkSlice) "munstreamUnknown" 0 n (length v') + $ unsafeSlice 0 n v' + where + {-# INLINE_INNER copyChunk #-} + copyChunk (v,i) (Chunk n f) + = do + let j = i+n + v' <- if basicLength v < j + then unsafeGrow v (delay_inline max (enlarge_delta v) (j - basicLength v)) + else return v + INTERNAL_CHECK(checkSlice) "munstreamUnknown.copyChunk" i n (length v') + $ f (basicUnsafeSlice i n v') + return (v',j) + + + + +-- | Create a new mutable vector and fill it with elements from the 'Bundle' +-- from right to left. The vector will grow exponentially if the maximum size +-- of the 'Bundle' is unknown. +unstreamR :: (PrimMonad m, MVector v a) + => Bundle u a -> m (v (PrimState m) a) +-- NOTE: replace INLINE_FUSED by INLINE? (also in unstream) +{-# INLINE_FUSED unstreamR #-} +unstreamR s = munstreamR (Bundle.lift s) + +-- | Create a new mutable vector and fill it with elements from the monadic +-- stream from right to left. The vector will grow exponentially if the maximum +-- size of the stream is unknown. +munstreamR :: (PrimMonad m, MVector v a) + => MBundle m u a -> m (v (PrimState m) a) +{-# INLINE_FUSED munstreamR #-} +munstreamR s = case upperBound (MBundle.size s) of + Just n -> munstreamRMax s n + Nothing -> munstreamRUnknown s + +munstreamRMax :: (PrimMonad m, MVector v a) + => MBundle m u a -> Int -> m (v (PrimState m) a) +{-# INLINE munstreamRMax #-} +munstreamRMax s n + = do + v <- INTERNAL_CHECK(checkLength) "munstreamRMax" n + $ unsafeNew n + let put i x = do + let i' = i-1 + INTERNAL_CHECK(checkIndex) "munstreamRMax" i' n + $ unsafeWrite v i' x + return i' + i <- MBundle.foldM' put n s + return $ INTERNAL_CHECK(checkSlice) "munstreamRMax" i (n-i) n + $ unsafeSlice i (n-i) v + +munstreamRUnknown :: (PrimMonad m, MVector v a) + => MBundle m u a -> m (v (PrimState m) a) +{-# INLINE munstreamRUnknown #-} +munstreamRUnknown s + = do + v <- unsafeNew 0 + (v', i) <- MBundle.foldM put (v, 0) s + let n = length v' + return $ INTERNAL_CHECK(checkSlice) "unstreamRUnknown" i (n-i) n + $ unsafeSlice i (n-i) v' + where + {-# INLINE_INNER put #-} + put (v,i) x = unsafePrepend1 v i x + +-- Length +-- ------ + +-- | Length of the mutable vector. +length :: MVector v a => v s a -> Int +{-# INLINE length #-} +length = basicLength + +-- | Check whether the vector is empty +null :: MVector v a => v s a -> Bool +{-# INLINE null #-} +null v = length v == 0 + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. +slice :: MVector v a => Int -> Int -> v s a -> v s a +{-# INLINE slice #-} +slice i n v = BOUNDS_CHECK(checkSlice) "slice" i n (length v) + $ unsafeSlice i n v + +take :: MVector v a => Int -> v s a -> v s a +{-# INLINE take #-} +take n v = unsafeSlice 0 (min (max n 0) (length v)) v + +drop :: MVector v a => Int -> v s a -> v s a +{-# INLINE drop #-} +drop n v = unsafeSlice (min m n') (max 0 (m - n')) v + where + n' = max n 0 + m = length v + +{-# INLINE splitAt #-} +splitAt :: MVector v a => Int -> v s a -> (v s a, v s a) +splitAt n v = ( unsafeSlice 0 m v + , unsafeSlice m (max 0 (len - n')) v + ) + where + m = min n' len + n' = max n 0 + len = length v + +init :: MVector v a => v s a -> v s a +{-# INLINE init #-} +init v = slice 0 (length v - 1) v + +tail :: MVector v a => v s a -> v s a +{-# INLINE tail #-} +tail v = slice 1 (length v - 1) v + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +unsafeSlice :: MVector v a => Int -- ^ starting index + -> Int -- ^ length of the slice + -> v s a + -> v s a +{-# INLINE unsafeSlice #-} +unsafeSlice i n v = UNSAFE_CHECK(checkSlice) "unsafeSlice" i n (length v) + $ basicUnsafeSlice i n v + +unsafeInit :: MVector v a => v s a -> v s a +{-# INLINE unsafeInit #-} +unsafeInit v = unsafeSlice 0 (length v - 1) v + +unsafeTail :: MVector v a => v s a -> v s a +{-# INLINE unsafeTail #-} +unsafeTail v = unsafeSlice 1 (length v - 1) v + +unsafeTake :: MVector v a => Int -> v s a -> v s a +{-# INLINE unsafeTake #-} +unsafeTake n v = unsafeSlice 0 n v + +unsafeDrop :: MVector v a => Int -> v s a -> v s a +{-# INLINE unsafeDrop #-} +unsafeDrop n v = unsafeSlice n (length v - n) v + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +overlaps :: MVector v a => v s a -> v s a -> Bool +{-# INLINE overlaps #-} +overlaps = basicOverlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +new :: (PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a) +{-# INLINE new #-} +new n = BOUNDS_CHECK(checkLength) "new" n + $ unsafeNew n >>= \v -> basicInitialize v >> return v + +-- | Create a mutable vector of the given length. The memory is not initialized. +unsafeNew :: (PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew n = UNSAFE_CHECK(checkLength) "unsafeNew" n + $ basicUnsafeNew n + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +replicate :: (PrimMonad m, MVector v a) => Int -> a -> m (v (PrimState m) a) +{-# INLINE replicate #-} +replicate n x = basicUnsafeReplicate (delay_inline max 0 n) x + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +replicateM :: (PrimMonad m, MVector v a) => Int -> m a -> m (v (PrimState m) a) +{-# INLINE replicateM #-} +replicateM n m = munstream (MBundle.replicateM n m) + +-- | Create a copy of a mutable vector. +clone :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m (v (PrimState m) a) +{-# INLINE clone #-} +clone v = do + v' <- unsafeNew (length v) + unsafeCopy v' v + return v' + +-- Growing +-- ------- + +-- | Grow a vector by the given number of elements. The number must be +-- positive. +grow :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> m (v (PrimState m) a) +{-# INLINE grow #-} +grow v by = BOUNDS_CHECK(checkLength) "grow" by + $ do vnew <- unsafeGrow v by + basicInitialize $ basicUnsafeSlice (length v) by vnew + return vnew + +growFront :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> m (v (PrimState m) a) +{-# INLINE growFront #-} +growFront v by = BOUNDS_CHECK(checkLength) "growFront" by + $ do vnew <- unsafeGrowFront v by + basicInitialize $ basicUnsafeSlice 0 by vnew + return vnew + +enlarge_delta :: MVector v a => v s a -> Int +enlarge_delta v = max (length v) 1 + +-- | Grow a vector logarithmically +enlarge :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> m (v (PrimState m) a) +{-# INLINE enlarge #-} +enlarge v = do vnew <- unsafeGrow v by + basicInitialize $ basicUnsafeSlice (length v) by vnew + return vnew + where + by = enlarge_delta v + +enlargeFront :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> m (v (PrimState m) a, Int) +{-# INLINE enlargeFront #-} +enlargeFront v = do + v' <- unsafeGrowFront v by + basicInitialize $ basicUnsafeSlice 0 by v' + return (v', by) + where + by = enlarge_delta v + +-- | Grow a vector by the given number of elements. The number must be +-- positive but this is not checked. +unsafeGrow :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> m (v (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow v n = UNSAFE_CHECK(checkLength) "unsafeGrow" n + $ basicUnsafeGrow v n + +unsafeGrowFront :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> m (v (PrimState m) a) +{-# INLINE unsafeGrowFront #-} +unsafeGrowFront v by = UNSAFE_CHECK(checkLength) "unsafeGrowFront" by + $ do + let n = length v + v' <- basicUnsafeNew (by+n) + basicUnsafeCopy (basicUnsafeSlice by n v') v + return v' + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- references to external objects. This is usually a noop for unboxed vectors. +clear :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m () +{-# INLINE clear #-} +clear = basicClear + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. +read :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read v i = BOUNDS_CHECK(checkIndex) "read" i (length v) + $ unsafeRead v i + +-- | Replace the element at the given position. +write :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m () +{-# INLINE write #-} +write v i x = BOUNDS_CHECK(checkIndex) "write" i (length v) + $ unsafeWrite v i x + +-- | Modify the element at the given position. +modify :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE modify #-} +modify v f i = BOUNDS_CHECK(checkIndex) "modify" i (length v) + $ unsafeModify v f i + +-- | Swap the elements at the given positions. +swap :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap v i j = BOUNDS_CHECK(checkIndex) "swap" i (length v) + $ BOUNDS_CHECK(checkIndex) "swap" j (length v) + $ unsafeSwap v i j + +-- | Replace the element at the give position and return the old element. +exchange :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m a +{-# INLINE exchange #-} +exchange v i x = BOUNDS_CHECK(checkIndex) "exchange" i (length v) + $ unsafeExchange v i x + +-- | Yield the element at the given position. No bounds checks are performed. +unsafeRead :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +unsafeRead v i = UNSAFE_CHECK(checkIndex) "unsafeRead" i (length v) + $ basicUnsafeRead v i + +-- | Replace the element at the given position. No bounds checks are performed. +unsafeWrite :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> a -> m () +{-# INLINE unsafeWrite #-} +unsafeWrite v i x = UNSAFE_CHECK(checkIndex) "unsafeWrite" i (length v) + $ basicUnsafeWrite v i x + +-- | Modify the element at the given position. No bounds checks are performed. +unsafeModify :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE unsafeModify #-} +unsafeModify v f i = UNSAFE_CHECK(checkIndex) "unsafeModify" i (length v) + $ basicUnsafeRead v i >>= \x -> + basicUnsafeWrite v i (f x) + +-- | Swap the elements at the given positions. No bounds checks are performed. +unsafeSwap :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> Int -> m () +{-# INLINE unsafeSwap #-} +unsafeSwap v i j = UNSAFE_CHECK(checkIndex) "unsafeSwap" i (length v) + $ UNSAFE_CHECK(checkIndex) "unsafeSwap" j (length v) + $ do + x <- unsafeRead v i + y <- unsafeRead v j + unsafeWrite v i y + unsafeWrite v j x + +-- | Replace the element at the give position and return the old element. No +-- bounds checks are performed. +unsafeExchange :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> a -> m a +{-# INLINE unsafeExchange #-} +unsafeExchange v i x = UNSAFE_CHECK(checkIndex) "unsafeExchange" i (length v) + $ do + y <- unsafeRead v i + unsafeWrite v i x + return y + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +set :: (PrimMonad m, MVector v a) => v (PrimState m) a -> a -> m () +{-# INLINE set #-} +set = basicSet + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +copy :: (PrimMonad m, MVector v a) => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () +{-# INLINE copy #-} +copy dst src = BOUNDS_CHECK(check) "copy" "overlapping vectors" + (not (dst `overlaps` src)) + $ BOUNDS_CHECK(check) "copy" "length mismatch" + (length dst == length src) + $ unsafeCopy dst src + +-- | Move the contents of a vector. The two vectors must have the same +-- length. +-- +-- If the vectors do not overlap, then this is equivalent to 'copy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +move :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> v (PrimState m) a -> m () +{-# INLINE move #-} +move dst src = BOUNDS_CHECK(check) "move" "length mismatch" + (length dst == length src) + $ unsafeMove dst src + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. This is not checked. +unsafeCopy :: (PrimMonad m, MVector v a) => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy dst src = UNSAFE_CHECK(check) "unsafeCopy" "length mismatch" + (length dst == length src) + $ UNSAFE_CHECK(check) "unsafeCopy" "overlapping vectors" + (not (dst `overlaps` src)) + $ (dst `seq` src `seq` basicUnsafeCopy dst src) + +-- | Move the contents of a vector. The two vectors must have the same +-- length, but this is not checked. +-- +-- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +unsafeMove :: (PrimMonad m, MVector v a) => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove dst src = UNSAFE_CHECK(check) "unsafeMove" "length mismatch" + (length dst == length src) + $ (dst `seq` src `seq` basicUnsafeMove dst src) + +-- Permutations +-- ------------ + +accum :: (PrimMonad m, MVector v a) + => (a -> b -> a) -> v (PrimState m) a -> Bundle u (Int, b) -> m () +{-# INLINE accum #-} +accum f !v s = Bundle.mapM_ upd s + where + {-# INLINE_INNER upd #-} + upd (i,b) = do + a <- BOUNDS_CHECK(checkIndex) "accum" i n + $ unsafeRead v i + unsafeWrite v i (f a b) + + !n = length v + +update :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Bundle u (Int, a) -> m () +{-# INLINE update #-} +update !v s = Bundle.mapM_ upd s + where + {-# INLINE_INNER upd #-} + upd (i,b) = BOUNDS_CHECK(checkIndex) "update" i n + $ unsafeWrite v i b + + !n = length v + +unsafeAccum :: (PrimMonad m, MVector v a) + => (a -> b -> a) -> v (PrimState m) a -> Bundle u (Int, b) -> m () +{-# INLINE unsafeAccum #-} +unsafeAccum f !v s = Bundle.mapM_ upd s + where + {-# INLINE_INNER upd #-} + upd (i,b) = do + a <- UNSAFE_CHECK(checkIndex) "accum" i n + $ unsafeRead v i + unsafeWrite v i (f a b) + + !n = length v + +unsafeUpdate :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Bundle u (Int, a) -> m () +{-# INLINE unsafeUpdate #-} +unsafeUpdate !v s = Bundle.mapM_ upd s + where + {-# INLINE_INNER upd #-} + upd (i,b) = UNSAFE_CHECK(checkIndex) "accum" i n + $ unsafeWrite v i b + + !n = length v + +reverse :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m () +{-# INLINE reverse #-} +reverse !v = reverse_loop 0 (length v - 1) + where + reverse_loop i j | i < j = do + unsafeSwap v i j + reverse_loop (i + 1) (j - 1) + reverse_loop _ _ = return () + +unstablePartition :: forall m v a. (PrimMonad m, MVector v a) + => (a -> Bool) -> v (PrimState m) a -> m Int +{-# INLINE unstablePartition #-} +unstablePartition f !v = from_left 0 (length v) + where + -- NOTE: GHC 6.10.4 panics without the signatures on from_left and + -- from_right + from_left :: Int -> Int -> m Int + from_left i j + | i == j = return i + | otherwise = do + x <- unsafeRead v i + if f x + then from_left (i+1) j + else from_right i (j-1) + + from_right :: Int -> Int -> m Int + from_right i j + | i == j = return i + | otherwise = do + x <- unsafeRead v j + if f x + then do + y <- unsafeRead v i + unsafeWrite v i x + unsafeWrite v j y + from_left (i+1) j + else from_right i (j-1) + +unstablePartitionBundle :: (PrimMonad m, MVector v a) + => (a -> Bool) -> Bundle u a -> m (v (PrimState m) a, v (PrimState m) a) +{-# INLINE unstablePartitionBundle #-} +unstablePartitionBundle f s + = case upperBound (Bundle.size s) of + Just n -> unstablePartitionMax f s n + Nothing -> partitionUnknown f s + +unstablePartitionMax :: (PrimMonad m, MVector v a) + => (a -> Bool) -> Bundle u a -> Int + -> m (v (PrimState m) a, v (PrimState m) a) +{-# INLINE unstablePartitionMax #-} +unstablePartitionMax f s n + = do + v <- INTERNAL_CHECK(checkLength) "unstablePartitionMax" n + $ unsafeNew n + let {-# INLINE_INNER put #-} + put (i, j) x + | f x = do + unsafeWrite v i x + return (i+1, j) + | otherwise = do + unsafeWrite v (j-1) x + return (i, j-1) + + (i,j) <- Bundle.foldM' put (0, n) s + return (unsafeSlice 0 i v, unsafeSlice j (n-j) v) + +partitionBundle :: (PrimMonad m, MVector v a) + => (a -> Bool) -> Bundle u a -> m (v (PrimState m) a, v (PrimState m) a) +{-# INLINE partitionBundle #-} +partitionBundle f s + = case upperBound (Bundle.size s) of + Just n -> partitionMax f s n + Nothing -> partitionUnknown f s + +partitionMax :: (PrimMonad m, MVector v a) + => (a -> Bool) -> Bundle u a -> Int -> m (v (PrimState m) a, v (PrimState m) a) +{-# INLINE partitionMax #-} +partitionMax f s n + = do + v <- INTERNAL_CHECK(checkLength) "unstablePartitionMax" n + $ unsafeNew n + + let {-# INLINE_INNER put #-} + put (i,j) x + | f x = do + unsafeWrite v i x + return (i+1,j) + + | otherwise = let j' = j-1 in + do + unsafeWrite v j' x + return (i,j') + + (i,j) <- Bundle.foldM' put (0,n) s + INTERNAL_CHECK(check) "partitionMax" "invalid indices" (i <= j) + $ return () + let l = unsafeSlice 0 i v + r = unsafeSlice j (n-j) v + reverse r + return (l,r) + +partitionUnknown :: (PrimMonad m, MVector v a) + => (a -> Bool) -> Bundle u a -> m (v (PrimState m) a, v (PrimState m) a) +{-# INLINE partitionUnknown #-} +partitionUnknown f s + = do + v1 <- unsafeNew 0 + v2 <- unsafeNew 0 + (v1', n1, v2', n2) <- Bundle.foldM' put (v1, 0, v2, 0) s + INTERNAL_CHECK(checkSlice) "partitionUnknown" 0 n1 (length v1') + $ INTERNAL_CHECK(checkSlice) "partitionUnknown" 0 n2 (length v2') + $ return (unsafeSlice 0 n1 v1', unsafeSlice 0 n2 v2') + where + -- NOTE: The case distinction has to be on the outside because + -- GHC creates a join point for the unsafeWrite even when everything + -- is inlined. This is bad because with the join point, v isn't getting + -- unboxed. + {-# INLINE_INNER put #-} + put (v1, i1, v2, i2) x + | f x = do + v1' <- unsafeAppend1 v1 i1 x + return (v1', i1+1, v2, i2) + | otherwise = do + v2' <- unsafeAppend1 v2 i2 x + return (v1, i1, v2', i2+1) + +{- +http://en.wikipedia.org/wiki/Permutation#Algorithms_to_generate_permutations + +The following algorithm generates the next permutation lexicographically after +a given permutation. It changes the given permutation in-place. + +1. Find the largest index k such that a[k] < a[k + 1]. If no such index exists, + the permutation is the last permutation. +2. Find the largest index l greater than k such that a[k] < a[l]. +3. Swap the value of a[k] with that of a[l]. +4. Reverse the sequence from a[k + 1] up to and including the final element a[n] +-} + +-- | Compute the next (lexicographically) permutation of given vector in-place. +-- Returns False when input is the last permtuation +nextPermutation :: (PrimMonad m,Ord e,MVector v e) => v (PrimState m) e -> m Bool +nextPermutation v + | dim < 2 = return False + | otherwise = do + val <- unsafeRead v 0 + (k,l) <- loop val (-1) 0 val 1 + if k < 0 + then return False + else unsafeSwap v k l >> + reverse (unsafeSlice (k+1) (dim-k-1) v) >> + return True + where loop !kval !k !l !prev !i + | i == dim = return (k,l) + | otherwise = do + cur <- unsafeRead v i + -- TODO: make tuple unboxed + let (kval',k') = if prev < cur then (prev,i-1) else (kval,k) + l' = if kval' < cur then i else l + loop kval' k' l' cur (i+1) + dim = length v diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable/Base.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable/Base.hs new file mode 100644 index 0000000000..ce931eec9b --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable/Base.hs @@ -0,0 +1,145 @@ +{-# LANGUAGE CPP, MultiParamTypeClasses, BangPatterns, TypeFamilies #-} +-- | +-- Module : Data.Vector.Generic.Mutable.Base +-- Copyright : (c) Roman Leshchinskiy 2008-2011 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Class of mutable vectors +-- + +module Data.Vector.Generic.Mutable.Base ( + MVector(..) +) where + +import Control.Monad.Primitive ( PrimMonad, PrimState ) + +-- Data.Vector.Internal.Check is unused +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- | Class of mutable vectors parametrised with a primitive state token. +-- +class MVector v a where + -- | Length of the mutable vector. This method should not be + -- called directly, use 'length' instead. + basicLength :: v s a -> Int + + -- | Yield a part of the mutable vector without copying it. This method + -- should not be called directly, use 'unsafeSlice' instead. + basicUnsafeSlice :: Int -- ^ starting index + -> Int -- ^ length of the slice + -> v s a + -> v s a + + -- | Check whether two vectors overlap. This method should not be + -- called directly, use 'overlaps' instead. + basicOverlaps :: v s a -> v s a -> Bool + + -- | Create a mutable vector of the given length. This method should not be + -- called directly, use 'unsafeNew' instead. + basicUnsafeNew :: PrimMonad m => Int -> m (v (PrimState m) a) + + -- | Initialize a vector to a standard value. This is intended to be called as + -- part of the safe new operation (and similar operations), to properly blank + -- the newly allocated memory if necessary. + -- + -- Vectors that are necessarily initialized as part of creation may implement + -- this as a no-op. + basicInitialize :: PrimMonad m => v (PrimState m) a -> m () + + -- | Create a mutable vector of the given length and fill it with an + -- initial value. This method should not be called directly, use + -- 'replicate' instead. + basicUnsafeReplicate :: PrimMonad m => Int -> a -> m (v (PrimState m) a) + + -- | Yield the element at the given position. This method should not be + -- called directly, use 'unsafeRead' instead. + basicUnsafeRead :: PrimMonad m => v (PrimState m) a -> Int -> m a + + -- | Replace the element at the given position. This method should not be + -- called directly, use 'unsafeWrite' instead. + basicUnsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m () + + -- | Reset all elements of the vector to some undefined value, clearing all + -- references to external objects. This is usually a noop for unboxed + -- vectors. This method should not be called directly, use 'clear' instead. + basicClear :: PrimMonad m => v (PrimState m) a -> m () + + -- | Set all elements of the vector to the given value. This method should + -- not be called directly, use 'set' instead. + basicSet :: PrimMonad m => v (PrimState m) a -> a -> m () + + -- | Copy a vector. The two vectors may not overlap. This method should not + -- be called directly, use 'unsafeCopy' instead. + basicUnsafeCopy :: PrimMonad m => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () + + -- | Move the contents of a vector. The two vectors may overlap. This method + -- should not be called directly, use 'unsafeMove' instead. + basicUnsafeMove :: PrimMonad m => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () + + -- | Grow a vector by the given number of elements. This method should not be + -- called directly, use 'unsafeGrow' instead. + basicUnsafeGrow :: PrimMonad m => v (PrimState m) a -> Int + -> m (v (PrimState m) a) + + {-# INLINE basicUnsafeReplicate #-} + basicUnsafeReplicate n x + = do + v <- basicUnsafeNew n + basicSet v x + return v + + {-# INLINE basicClear #-} + basicClear _ = return () + + {-# INLINE basicSet #-} + basicSet !v x + | n == 0 = return () + | otherwise = do + basicUnsafeWrite v 0 x + do_set 1 + where + !n = basicLength v + + do_set i | 2*i < n = do basicUnsafeCopy (basicUnsafeSlice i i v) + (basicUnsafeSlice 0 i v) + do_set (2*i) + | otherwise = basicUnsafeCopy (basicUnsafeSlice i (n-i) v) + (basicUnsafeSlice 0 (n-i) v) + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy !dst !src = do_copy 0 + where + !n = basicLength src + + do_copy i | i < n = do + x <- basicUnsafeRead src i + basicUnsafeWrite dst i x + do_copy (i+1) + | otherwise = return () + + {-# INLINE basicUnsafeMove #-} + basicUnsafeMove !dst !src + | basicOverlaps dst src = do + srcCopy <- basicUnsafeNew (basicLength src) + basicUnsafeCopy srcCopy src + basicUnsafeCopy dst srcCopy + | otherwise = basicUnsafeCopy dst src + + {-# INLINE basicUnsafeGrow #-} + basicUnsafeGrow v by + = do + v' <- basicUnsafeNew (n+by) + basicUnsafeCopy (basicUnsafeSlice 0 n v') v + return v' + where + n = basicLength v + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/New.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/New.hs new file mode 100644 index 0000000000..e94ce19e16 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/New.hs @@ -0,0 +1,178 @@ +{-# LANGUAGE CPP, Rank2Types, FlexibleContexts, MultiParamTypeClasses #-} + +-- | +-- Module : Data.Vector.Generic.New +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Purely functional interface to initialisation of mutable vectors +-- + +module Data.Vector.Generic.New ( + New(..), create, run, runPrim, apply, modify, modifyWithBundle, + unstream, transform, unstreamR, transformR, + slice, init, tail, take, drop, + unsafeSlice, unsafeInit, unsafeTail +) where + +import qualified Data.Vector.Generic.Mutable as MVector + +import Data.Vector.Generic.Base ( Vector, Mutable ) + +import Data.Vector.Fusion.Bundle ( Bundle ) +import qualified Data.Vector.Fusion.Bundle as Bundle +import Data.Vector.Fusion.Stream.Monadic ( Stream ) +import Data.Vector.Fusion.Bundle.Size + +import Control.Monad.Primitive +import Control.Monad.ST ( ST ) +import Control.Monad ( liftM ) +import Prelude hiding ( init, tail, take, drop, reverse, map, filter ) + +-- Data.Vector.Internal.Check is unused +#define NOT_VECTOR_MODULE +#include "vector.h" + +data New v a = New (forall s. ST s (Mutable v s a)) + +create :: (forall s. ST s (Mutable v s a)) -> New v a +{-# INLINE create #-} +create p = New p + +run :: New v a -> ST s (Mutable v s a) +{-# INLINE run #-} +run (New p) = p + +runPrim :: PrimMonad m => New v a -> m (Mutable v (PrimState m) a) +{-# INLINE runPrim #-} +runPrim (New p) = primToPrim p + +apply :: (forall s. Mutable v s a -> Mutable v s a) -> New v a -> New v a +{-# INLINE apply #-} +apply f (New p) = New (liftM f p) + +modify :: (forall s. Mutable v s a -> ST s ()) -> New v a -> New v a +{-# INLINE modify #-} +modify f (New p) = New (do { v <- p; f v; return v }) + +modifyWithBundle :: (forall s. Mutable v s a -> Bundle u b -> ST s ()) + -> New v a -> Bundle u b -> New v a +{-# INLINE_FUSED modifyWithBundle #-} +modifyWithBundle f (New p) s = s `seq` New (do { v <- p; f v s; return v }) + +unstream :: Vector v a => Bundle v a -> New v a +{-# INLINE_FUSED unstream #-} +unstream s = s `seq` New (MVector.vunstream s) + +transform + :: Vector v a => (forall m. Monad m => Stream m a -> Stream m a) + -> (Size -> Size) -> New v a -> New v a +{-# INLINE_FUSED transform #-} +transform f _ (New p) = New (MVector.transform f =<< p) + +{-# RULES + +"transform/transform [New]" + forall (f1 :: forall m. Monad m => Stream m a -> Stream m a) + (f2 :: forall m. Monad m => Stream m a -> Stream m a) + g1 g2 p . + transform f1 g1 (transform f2 g2 p) = transform (f1 . f2) (g1 . g2) p + +"transform/unstream [New]" + forall (f :: forall m. Monad m => Stream m a -> Stream m a) + g s. + transform f g (unstream s) = unstream (Bundle.inplace f g s) #-} + + + + +unstreamR :: Vector v a => Bundle v a -> New v a +{-# INLINE_FUSED unstreamR #-} +unstreamR s = s `seq` New (MVector.unstreamR s) + +transformR + :: Vector v a => (forall m. Monad m => Stream m a -> Stream m a) + -> (Size -> Size) -> New v a -> New v a +{-# INLINE_FUSED transformR #-} +transformR f _ (New p) = New (MVector.transformR f =<< p) + +{-# RULES + +"transformR/transformR [New]" + forall (f1 :: forall m. Monad m => Stream m a -> Stream m a) + (f2 :: forall m. Monad m => Stream m a -> Stream m a) + g1 g2 + p . + transformR f1 g1 (transformR f2 g2 p) = transformR (f1 . f2) (g1 . g2) p + +"transformR/unstreamR [New]" + forall (f :: forall m. Monad m => Stream m a -> Stream m a) + g s. + transformR f g (unstreamR s) = unstreamR (Bundle.inplace f g s) #-} + + + +slice :: Vector v a => Int -> Int -> New v a -> New v a +{-# INLINE_FUSED slice #-} +slice i n m = apply (MVector.slice i n) m + +init :: Vector v a => New v a -> New v a +{-# INLINE_FUSED init #-} +init m = apply MVector.init m + +tail :: Vector v a => New v a -> New v a +{-# INLINE_FUSED tail #-} +tail m = apply MVector.tail m + +take :: Vector v a => Int -> New v a -> New v a +{-# INLINE_FUSED take #-} +take n m = apply (MVector.take n) m + +drop :: Vector v a => Int -> New v a -> New v a +{-# INLINE_FUSED drop #-} +drop n m = apply (MVector.drop n) m + +unsafeSlice :: Vector v a => Int -> Int -> New v a -> New v a +{-# INLINE_FUSED unsafeSlice #-} +unsafeSlice i n m = apply (MVector.unsafeSlice i n) m + +unsafeInit :: Vector v a => New v a -> New v a +{-# INLINE_FUSED unsafeInit #-} +unsafeInit m = apply MVector.unsafeInit m + +unsafeTail :: Vector v a => New v a -> New v a +{-# INLINE_FUSED unsafeTail #-} +unsafeTail m = apply MVector.unsafeTail m + +{-# RULES + +"slice/unstream [New]" forall i n s. + slice i n (unstream s) = unstream (Bundle.slice i n s) + +"init/unstream [New]" forall s. + init (unstream s) = unstream (Bundle.init s) + +"tail/unstream [New]" forall s. + tail (unstream s) = unstream (Bundle.tail s) + +"take/unstream [New]" forall n s. + take n (unstream s) = unstream (Bundle.take n s) + +"drop/unstream [New]" forall n s. + drop n (unstream s) = unstream (Bundle.drop n s) + +"unsafeSlice/unstream [New]" forall i n s. + unsafeSlice i n (unstream s) = unstream (Bundle.slice i n s) + +"unsafeInit/unstream [New]" forall s. + unsafeInit (unstream s) = unstream (Bundle.init s) + +"unsafeTail/unstream [New]" forall s. + unsafeTail (unstream s) = unstream (Bundle.tail s) #-} + + + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Internal/Check.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Internal/Check.hs new file mode 100644 index 0000000000..4a4ef80fe1 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Internal/Check.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE CPP #-} + +-- | +-- Module : Data.Vector.Internal.Check +-- Copyright : (c) Roman Leshchinskiy 2009 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Bounds checking infrastructure +-- + +{-# LANGUAGE MagicHash #-} + +module Data.Vector.Internal.Check ( + Checks(..), doChecks, + + error, internalError, + check, checkIndex, checkLength, checkSlice +) where + +import GHC.Base( Int(..) ) +import GHC.Prim( Int# ) +import Prelude hiding( error, (&&), (||), not ) +import qualified Prelude as P + +-- NOTE: This is a workaround for GHC's weird behaviour where it doesn't inline +-- these functions into unfoldings which makes the intermediate code size +-- explode. See http://hackage.haskell.org/trac/ghc/ticket/5539. +infixr 2 || +infixr 3 && + +not :: Bool -> Bool +{-# INLINE not #-} +not True = False +not False = True + +(&&) :: Bool -> Bool -> Bool +{-# INLINE (&&) #-} +False && _ = False +True && x = x + +(||) :: Bool -> Bool -> Bool +{-# INLINE (||) #-} +True || _ = True +False || x = x + + +data Checks = Bounds | Unsafe | Internal deriving( Eq ) + +doBoundsChecks :: Bool +#ifdef VECTOR_BOUNDS_CHECKS +doBoundsChecks = True +#else +doBoundsChecks = False +#endif + +doUnsafeChecks :: Bool +#ifdef VECTOR_UNSAFE_CHECKS +doUnsafeChecks = True +#else +doUnsafeChecks = False +#endif + +doInternalChecks :: Bool +#ifdef VECTOR_INTERNAL_CHECKS +doInternalChecks = True +#else +doInternalChecks = False +#endif + + +doChecks :: Checks -> Bool +{-# INLINE doChecks #-} +doChecks Bounds = doBoundsChecks +doChecks Unsafe = doUnsafeChecks +doChecks Internal = doInternalChecks + +error_msg :: String -> Int -> String -> String -> String +error_msg file line loc msg = file ++ ":" ++ show line ++ " (" ++ loc ++ "): " ++ msg + +error :: String -> Int -> String -> String -> a +{-# NOINLINE error #-} +error file line loc msg + = P.error $ error_msg file line loc msg + +internalError :: String -> Int -> String -> String -> a +{-# NOINLINE internalError #-} +internalError file line loc msg + = P.error $ unlines + ["*** Internal error in package vector ***" + ,"*** Please submit a bug report at http://trac.haskell.org/vector" + ,error_msg file line loc msg] + + +checkError :: String -> Int -> Checks -> String -> String -> a +{-# NOINLINE checkError #-} +checkError file line kind loc msg + = case kind of + Internal -> internalError file line loc msg + _ -> error file line loc msg + +check :: String -> Int -> Checks -> String -> String -> Bool -> a -> a +{-# INLINE check #-} +check file line kind loc msg cond x + | not (doChecks kind) || cond = x + | otherwise = checkError file line kind loc msg + +checkIndex_msg :: Int -> Int -> String +{-# INLINE checkIndex_msg #-} +checkIndex_msg (I# i#) (I# n#) = checkIndex_msg# i# n# + +checkIndex_msg# :: Int# -> Int# -> String +{-# NOINLINE checkIndex_msg# #-} +checkIndex_msg# i# n# = "index out of bounds " ++ show (I# i#, I# n#) + +checkIndex :: String -> Int -> Checks -> String -> Int -> Int -> a -> a +{-# INLINE checkIndex #-} +checkIndex file line kind loc i n x + = check file line kind loc (checkIndex_msg i n) (i >= 0 && i<n) x + + +checkLength_msg :: Int -> String +{-# INLINE checkLength_msg #-} +checkLength_msg (I# n#) = checkLength_msg# n# + +checkLength_msg# :: Int# -> String +{-# NOINLINE checkLength_msg# #-} +checkLength_msg# n# = "negative length " ++ show (I# n#) + +checkLength :: String -> Int -> Checks -> String -> Int -> a -> a +{-# INLINE checkLength #-} +checkLength file line kind loc n x + = check file line kind loc (checkLength_msg n) (n >= 0) x + + +checkSlice_msg :: Int -> Int -> Int -> String +{-# INLINE checkSlice_msg #-} +checkSlice_msg (I# i#) (I# m#) (I# n#) = checkSlice_msg# i# m# n# + +checkSlice_msg# :: Int# -> Int# -> Int# -> String +{-# NOINLINE checkSlice_msg# #-} +checkSlice_msg# i# m# n# = "invalid slice " ++ show (I# i#, I# m#, I# n#) + +checkSlice :: String -> Int -> Checks -> String -> Int -> Int -> Int -> a -> a +{-# INLINE checkSlice #-} +checkSlice file line kind loc i m n x + = check file line kind loc (checkSlice_msg i m n) + (i >= 0 && m >= 0 && i+m <= n) x + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Mutable.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Mutable.hs new file mode 100644 index 0000000000..ba701afb6a --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Mutable.hs @@ -0,0 +1,416 @@ +{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, BangPatterns, TypeFamilies #-} + +-- | +-- Module : Data.Vector.Mutable +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Mutable boxed vectors. +-- + +module Data.Vector.Mutable ( + -- * Mutable boxed vectors + MVector(..), IOVector, STVector, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, clone, + + -- ** Growing + grow, unsafeGrow, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, write, modify, swap, + unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, + + -- * Modifying vectors + nextPermutation, + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove +) where + +import Control.Monad (when) +import qualified Data.Vector.Generic.Mutable as G +import Data.Primitive.Array +import Control.Monad.Primitive + +import Prelude hiding ( length, null, replicate, reverse, read, + take, drop, splitAt, init, tail ) + +import Data.Typeable ( Typeable ) + +#include "vector.h" + +-- | Mutable boxed vectors keyed on the monad they live in ('IO' or @'ST' s@). +data MVector s a = MVector {-# UNPACK #-} !Int + {-# UNPACK #-} !Int + {-# UNPACK #-} !(MutableArray s a) + deriving ( Typeable ) + +type IOVector = MVector RealWorld +type STVector s = MVector s + +-- NOTE: This seems unsafe, see http://trac.haskell.org/vector/ticket/54 +{- +instance NFData a => NFData (MVector s a) where + rnf (MVector i n arr) = unsafeInlineST $ force i + where + force !ix | ix < n = do x <- readArray arr ix + rnf x `seq` force (ix+1) + | otherwise = return () +-} + +instance G.MVector MVector a where + {-# INLINE basicLength #-} + basicLength (MVector _ n _) = n + + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice j m (MVector i _ arr) = MVector (i+j) m arr + + {-# INLINE basicOverlaps #-} + basicOverlaps (MVector i m arr1) (MVector j n arr2) + = sameMutableArray 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 + = do + arr <- newArray n uninitialised + return (MVector 0 n arr) + + {-# INLINE basicInitialize #-} + -- initialization is unnecessary for boxed vectors + basicInitialize _ = return () + + {-# INLINE basicUnsafeReplicate #-} + basicUnsafeReplicate n x + = do + arr <- newArray n x + return (MVector 0 n arr) + + {-# INLINE basicUnsafeRead #-} + basicUnsafeRead (MVector i _ arr) j = readArray arr (i+j) + + {-# INLINE basicUnsafeWrite #-} + basicUnsafeWrite (MVector i _ arr) j x = writeArray arr (i+j) x + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MVector i n dst) (MVector j _ src) + = copyMutableArray dst i src j n + + basicUnsafeMove dst@(MVector iDst n arrDst) src@(MVector iSrc _ arrSrc) + = case n of + 0 -> return () + 1 -> readArray arrSrc iSrc >>= writeArray arrDst iDst + 2 -> do + x <- readArray arrSrc iSrc + y <- readArray arrSrc (iSrc + 1) + writeArray arrDst iDst x + writeArray arrDst (iDst + 1) y + _ + | overlaps dst src + -> case compare iDst iSrc of + LT -> moveBackwards arrDst iDst iSrc n + EQ -> return () + GT | (iDst - iSrc) * 2 < n + -> moveForwardsLargeOverlap arrDst iDst iSrc n + | otherwise + -> moveForwardsSmallOverlap arrDst iDst iSrc n + | otherwise -> G.basicUnsafeCopy dst src + + {-# INLINE basicClear #-} + basicClear v = G.set v uninitialised + +{-# INLINE moveBackwards #-} +moveBackwards :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () +moveBackwards !arr !dstOff !srcOff !len = + INTERNAL_CHECK(check) "moveBackwards" "not a backwards move" (dstOff < srcOff) + $ loopM len $ \ i -> readArray arr (srcOff + i) >>= writeArray arr (dstOff + i) + +{-# INLINE moveForwardsSmallOverlap #-} +-- Performs a move when dstOff > srcOff, optimized for when the overlap of the intervals is small. +moveForwardsSmallOverlap :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () +moveForwardsSmallOverlap !arr !dstOff !srcOff !len = + INTERNAL_CHECK(check) "moveForwardsSmallOverlap" "not a forward move" (dstOff > srcOff) + $ do + tmp <- newArray overlap uninitialised + loopM overlap $ \ i -> readArray arr (dstOff + i) >>= writeArray tmp i + loopM nonOverlap $ \ i -> readArray arr (srcOff + i) >>= writeArray arr (dstOff + i) + loopM overlap $ \ i -> readArray tmp i >>= writeArray arr (dstOff + nonOverlap + i) + where nonOverlap = dstOff - srcOff; overlap = len - nonOverlap + +-- Performs a move when dstOff > srcOff, optimized for when the overlap of the intervals is large. +moveForwardsLargeOverlap :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () +moveForwardsLargeOverlap !arr !dstOff !srcOff !len = + INTERNAL_CHECK(check) "moveForwardsLargeOverlap" "not a forward move" (dstOff > srcOff) + $ do + queue <- newArray nonOverlap uninitialised + loopM nonOverlap $ \ i -> readArray arr (srcOff + i) >>= writeArray queue i + let mov !i !qTop = when (i < dstOff + len) $ do + x <- readArray arr i + y <- readArray queue qTop + writeArray arr i y + writeArray queue qTop x + mov (i+1) (if qTop + 1 >= nonOverlap then 0 else qTop + 1) + mov dstOff 0 + where nonOverlap = dstOff - srcOff + +{-# INLINE loopM #-} +loopM :: Monad m => Int -> (Int -> m a) -> m () +loopM !n k = let + go i = when (i < n) (k i >> go (i+1)) + in go 0 + +uninitialised :: a +uninitialised = error "Data.Vector.Mutable: uninitialised element" + +-- Length information +-- ------------------ + +-- | Length of the mutable vector. +length :: MVector s a -> Int +{-# INLINE length #-} +length = G.length + +-- | Check whether the vector is empty +null :: MVector s a -> Bool +{-# INLINE null #-} +null = G.null + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. +slice :: Int -> Int -> MVector s a -> MVector s a +{-# INLINE slice #-} +slice = G.slice + +take :: Int -> MVector s a -> MVector s a +{-# INLINE take #-} +take = G.take + +drop :: Int -> MVector s a -> MVector s a +{-# INLINE drop #-} +drop = G.drop + +{-# INLINE splitAt #-} +splitAt :: Int -> MVector s a -> (MVector s a, MVector s a) +splitAt = G.splitAt + +init :: MVector s a -> MVector s a +{-# INLINE init #-} +init = G.init + +tail :: MVector s a -> MVector s a +{-# INLINE tail #-} +tail = G.tail + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +unsafeSlice :: Int -- ^ starting index + -> Int -- ^ length of the slice + -> MVector s a + -> MVector s a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +unsafeTake :: Int -> MVector s a -> MVector s a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +unsafeDrop :: Int -> MVector s a -> MVector s a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +unsafeInit :: MVector s a -> MVector s a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +unsafeTail :: MVector s a -> MVector s a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +overlaps :: MVector s a -> MVector s a -> Bool +{-# INLINE overlaps #-} +overlaps = G.overlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +new :: PrimMonad m => Int -> m (MVector (PrimState m) a) +{-# INLINE new #-} +new = G.new + +-- | Create a mutable vector of the given length. The memory is not initialized. +unsafeNew :: PrimMonad m => Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew = G.unsafeNew + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +replicate :: PrimMonad m => Int -> a -> m (MVector (PrimState m) a) +{-# INLINE replicate #-} +replicate = G.replicate + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +replicateM :: PrimMonad m => Int -> m a -> m (MVector (PrimState m) a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | Create a copy of a mutable vector. +clone :: PrimMonad m => MVector (PrimState m) a -> m (MVector (PrimState m) a) +{-# INLINE clone #-} +clone = G.clone + +-- Growing +-- ------- + +-- | Grow a vector by the given number of elements. The number must be +-- positive. +grow :: PrimMonad m + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE grow #-} +grow = G.grow + +-- | Grow a vector by the given number of elements. The number must be +-- positive but this is not checked. +unsafeGrow :: PrimMonad m + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow = G.unsafeGrow + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- references to external objects. This is usually a noop for unboxed vectors. +clear :: PrimMonad m => MVector (PrimState m) a -> m () +{-# INLINE clear #-} +clear = G.clear + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. +read :: PrimMonad m => MVector (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read = G.read + +-- | Replace the element at the given position. +write :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE write #-} +write = G.write + +-- | Modify the element at the given position. +modify :: PrimMonad m => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE modify #-} +modify = G.modify + +-- | Swap the elements at the given positions. +swap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap = G.swap + + +-- | Yield the element at the given position. No bounds checks are performed. +unsafeRead :: PrimMonad m => MVector (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +unsafeRead = G.unsafeRead + +-- | Replace the element at the given position. No bounds checks are performed. +unsafeWrite :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE unsafeWrite #-} +unsafeWrite = G.unsafeWrite + +-- | Modify the element at the given position. No bounds checks are performed. +unsafeModify :: PrimMonad m => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE unsafeModify #-} +unsafeModify = G.unsafeModify + +-- | Swap the elements at the given positions. No bounds checks are performed. +unsafeSwap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE unsafeSwap #-} +unsafeSwap = G.unsafeSwap + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +set :: PrimMonad m => MVector (PrimState m) a -> a -> m () +{-# INLINE set #-} +set = G.set + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +copy :: PrimMonad m + => MVector (PrimState m) a -> MVector (PrimState m) a -> m () +{-# INLINE copy #-} +copy = G.copy + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. This is not checked. +unsafeCopy :: PrimMonad m => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | Move the contents of a vector. The two vectors must have the same +-- length. +-- +-- If the vectors do not overlap, then this is equivalent to 'copy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +move :: PrimMonad m + => MVector (PrimState m) a -> MVector (PrimState m) a -> m () +{-# INLINE move #-} +move = G.move + +-- | Move the contents of a vector. The two vectors must have the same +-- length, but this is not checked. +-- +-- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +unsafeMove :: PrimMonad m => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove = G.unsafeMove + +-- | Compute the next (lexicographically) permutation of given vector in-place. +-- Returns False when input is the last permtuation +nextPermutation :: (PrimMonad m,Ord e) => MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutation #-} +nextPermutation = G.nextPermutation diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Primitive.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Primitive.hs new file mode 100644 index 0000000000..ba18f9ba95 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Primitive.hs @@ -0,0 +1,1393 @@ +{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables, Rank2Types #-} + +-- | +-- Module : Data.Vector.Primitive +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Unboxed vectors of primitive types. The use of this module is not +-- recommended except in very special cases. Adaptive unboxed vectors defined +-- in "Data.Vector.Unboxed" are significantly more flexible at no performance +-- cost. +-- + +module Data.Vector.Primitive ( + -- * Primitive vectors + Vector(..), MVector(..), Prim, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + unsafeIndex, unsafeHead, unsafeLast, + + -- ** Monadic indexing + indexM, headM, lastM, + unsafeIndexM, unsafeHeadM, unsafeLastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, iterateNM, create, createT, + + -- ** Unfolding + unfoldr, unfoldrN, + unfoldrM, unfoldrNM, + constructN, constructrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update_, + unsafeUpd, unsafeUpdate_, + + -- ** Accumulations + accum, accumulate_, + unsafeAccum, unsafeAccumulate_, + + -- ** Permutations + reverse, backpermute, unsafeBackpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, mapM_, forM, forM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + + -- ** Monadic zipping + zipWithM, zipWithM_, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, uniq, + mapMaybe, imapMaybe, + filterM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, span, break, + + -- ** Searching + elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + + -- ** Specialised folds + all, any, + sum, product, + maximum, maximumBy, minimum, minimumBy, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, foldM', fold1M, fold1M', + foldM_, foldM'_, fold1M_, fold1M'_, + + -- * Prefix sums (scans) + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Other vector types + G.convert, + + -- ** Mutable vectors + freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy +) where + +import qualified Data.Vector.Generic as G +import Data.Vector.Primitive.Mutable ( MVector(..) ) +import qualified Data.Vector.Fusion.Bundle as Bundle +import Data.Primitive.ByteArray +import Data.Primitive ( Prim, sizeOf ) + +import Control.DeepSeq ( NFData(rnf) ) + +import Control.Monad ( liftM ) +import Control.Monad.ST ( ST ) +import Control.Monad.Primitive + +import Prelude hiding ( length, null, + replicate, (++), concat, + head, last, + init, tail, take, drop, splitAt, reverse, + map, concatMap, + zipWith, zipWith3, zip, zip3, unzip, unzip3, + filter, takeWhile, dropWhile, span, break, + elem, notElem, + foldl, foldl1, foldr, foldr1, + all, any, sum, product, minimum, maximum, + scanl, scanl1, scanr, scanr1, + enumFromTo, enumFromThenTo, + mapM, mapM_ ) + +import Data.Typeable ( Typeable ) +import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) +import Data.Semigroup ( Semigroup(..) ) + +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid ( Monoid(..) ) +import Data.Traversable ( Traversable ) +#endif + +#if __GLASGOW_HASKELL__ >= 708 +import qualified GHC.Exts as Exts +#endif + +-- | Unboxed vectors of primitive types +data Vector a = Vector {-# UNPACK #-} !Int + {-# UNPACK #-} !Int + {-# UNPACK #-} !ByteArray -- ^ offset, length, underlying byte array + deriving ( Typeable ) + +instance NFData (Vector a) where + rnf (Vector _ _ _) = () + +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 _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = G.mkType "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) + + {-# INLINE (/=) #-} + xs /= ys = not (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 + +#if __GLASGOW_HASKELL__ >= 708 + +instance Prim a => Exts.IsList (Vector a) where + type Item (Vector a) = a + fromList = fromList + fromListN = fromListN + toList = toList + +#endif +-- Length +-- ------ + +-- | /O(1)/ Yield the length of the vector +length :: Prim a => Vector a -> Int +{-# INLINE length #-} +length = G.length + +-- | /O(1)/ Test whether a vector is empty +null :: Prim a => Vector a -> Bool +{-# INLINE null #-} +null = G.null + +-- Indexing +-- -------- + +-- | O(1) Indexing +(!) :: Prim a => Vector a -> Int -> a +{-# INLINE (!) #-} +(!) = (G.!) + +-- | O(1) Safe indexing +(!?) :: Prim a => Vector a -> Int -> Maybe a +{-# INLINE (!?) #-} +(!?) = (G.!?) + +-- | /O(1)/ First element +head :: Prim a => Vector a -> a +{-# INLINE head #-} +head = G.head + +-- | /O(1)/ Last element +last :: Prim a => Vector a -> a +{-# INLINE last #-} +last = G.last + +-- | /O(1)/ Unsafe indexing without bounds checking +unsafeIndex :: Prim a => Vector a -> Int -> a +{-# INLINE unsafeIndex #-} +unsafeIndex = G.unsafeIndex + +-- | /O(1)/ First element without checking if the vector is empty +unsafeHead :: Prim a => Vector a -> a +{-# INLINE unsafeHead #-} +unsafeHead = G.unsafeHead + +-- | /O(1)/ Last element without checking if the vector is empty +unsafeLast :: Prim a => Vector a -> a +{-# INLINE unsafeLast #-} +unsafeLast = G.unsafeLast + +-- Monadic indexing +-- ---------------- + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the vector when necessary. +-- Suppose vector copying is implemented like this: +-- +-- > copy mv v = ... write mv i (v ! i) ... +-- +-- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ +-- would unnecessarily retain a reference to @v@ in each element written. +-- +-- With 'indexM', copying can be implemented like this instead: +-- +-- > copy mv v = ... do +-- > x <- indexM v i +-- > write mv i x +-- +-- Here, no references to @v@ are retained because indexing (but /not/ the +-- elements) is evaluated eagerly. +-- +indexM :: (Prim a, Monad m) => Vector a -> Int -> m a +{-# INLINE indexM #-} +indexM = G.indexM + +-- | /O(1)/ First element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +headM :: (Prim a, Monad m) => Vector a -> m a +{-# INLINE headM #-} +headM = G.headM + +-- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +lastM :: (Prim a, Monad m) => Vector a -> m a +{-# INLINE lastM #-} +lastM = G.lastM + +-- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an +-- explanation of why this is useful. +unsafeIndexM :: (Prim a, Monad m) => Vector a -> Int -> m a +{-# INLINE unsafeIndexM #-} +unsafeIndexM = G.unsafeIndexM + +-- | /O(1)/ First element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeHeadM :: (Prim a, Monad m) => Vector a -> m a +{-# INLINE unsafeHeadM #-} +unsafeHeadM = G.unsafeHeadM + +-- | /O(1)/ Last element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeLastM :: (Prim a, Monad m) => Vector a -> m a +{-# INLINE unsafeLastM #-} +unsafeLastM = G.unsafeLastM + +-- Extracting subvectors (slicing) +-- ------------------------------- + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Prim a + => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE slice #-} +slice = G.slice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty. +init :: Prim a => Vector a -> Vector a +{-# INLINE init #-} +init = G.init + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty. +tail :: Prim a => Vector a -> Vector a +{-# INLINE tail #-} +tail = G.tail + +-- | /O(1)/ Yield at the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case it is returned unchanged. +take :: Prim a => Int -> Vector a -> Vector a +{-# INLINE take #-} +take = G.take + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case an empty vector is returned. +drop :: Prim a => Int -> Vector a -> Vector a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ +-- but slightly more efficient. +{-# INLINE splitAt #-} +splitAt :: Prim a => Int -> Vector a -> (Vector a, Vector a) +splitAt = G.splitAt + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must +-- contain at least @i+n@ elements but this is not checked. +unsafeSlice :: Prim a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty but this is not checked. +unsafeInit :: Prim a => Vector a -> Vector a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty but this is not checked. +unsafeTail :: Prim a => Vector a -> Vector a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector must +-- contain at least @n@ elements but this is not checked. +unsafeTake :: Prim a => Int -> Vector a -> Vector a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector +-- must contain at least @n@ elements but this is not checked. +unsafeDrop :: Prim a => Int -> Vector a -> Vector a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- Initialisation +-- -------------- + +-- | /O(1)/ Empty vector +empty :: Prim a => Vector a +{-# INLINE empty #-} +empty = G.empty + +-- | /O(1)/ Vector with exactly one element +singleton :: Prim a => a -> Vector a +{-# INLINE singleton #-} +singleton = G.singleton + +-- | /O(n)/ Vector of the given length with the same value in each position +replicate :: Prim a => Int -> a -> Vector a +{-# INLINE replicate #-} +replicate = G.replicate + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index +generate :: Prim a => Int -> (Int -> a) -> Vector a +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Apply function n times to value. Zeroth element is original value. +iterateN :: Prim a => Int -> (a -> a) -> a -> Vector a +{-# INLINE iterateN #-} +iterateN = G.iterateN + +-- Unfolding +-- --------- + +-- | /O(n)/ Construct a vector by repeatedly applying the generator function +-- to a seed. The generator function yields 'Just' the next element and the +-- new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 +-- > = <10,9,8,7,6,5,4,3,2,1> +unfoldr :: Prim a => (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldr #-} +unfoldr = G.unfoldr + +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> +unfoldrN :: Prim a => Int -> (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldrN #-} +unfoldrN = G.unfoldrN + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Prim a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Prim a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in f <a,b,c> +-- +constructN :: Prim a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in f <c,b,a> +-- +constructrN :: Prim a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN + +-- Enumeration +-- ----------- + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ +-- etc. This operation is usually more efficient than 'enumFromTo'. +-- +-- > enumFromN 5 3 = <5,6,7> +enumFromN :: (Prim a, Num a) => a -> Int -> Vector a +{-# INLINE enumFromN #-} +enumFromN = G.enumFromN + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, +-- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. +-- +-- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> +enumFromStepN :: (Prim a, Num a) => a -> a -> Int -> Vector a +{-# INLINE enumFromStepN #-} +enumFromStepN = G.enumFromStepN + +-- | /O(n)/ Enumerate values from @x@ to @y@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromN' instead. +enumFromTo :: (Prim a, Enum a) => a -> a -> Vector a +{-# INLINE enumFromTo #-} +enumFromTo = G.enumFromTo + +-- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Prim a, Enum a) => a -> a -> a -> Vector a +{-# INLINE enumFromThenTo #-} +enumFromThenTo = G.enumFromThenTo + +-- Concatenation +-- ------------- + +-- | /O(n)/ Prepend an element +cons :: Prim a => a -> Vector a -> Vector a +{-# INLINE cons #-} +cons = G.cons + +-- | /O(n)/ Append an element +snoc :: Prim a => Vector a -> a -> Vector a +{-# INLINE snoc #-} +snoc = G.snoc + +infixr 5 ++ +-- | /O(m+n)/ Concatenate two vectors +(++) :: Prim a => Vector a -> Vector a -> Vector a +{-# INLINE (++) #-} +(++) = (G.++) + +-- | /O(n)/ Concatenate all vectors in the list +concat :: Prim a => [Vector a] -> Vector a +{-# INLINE concat #-} +concat = G.concat + +-- Monadic initialisation +-- ---------------------- + +-- | /O(n)/ Execute the monadic action the given number of times and store the +-- results in a vector. +replicateM :: (Monad m, Prim a) => Int -> m a -> m (Vector a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +generateM :: (Monad m, Prim a) => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: (Monad m, Prim a) => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + +-- | Execute the monadic action and freeze the resulting vector. +-- +-- @ +-- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> +-- @ +create :: Prim a => (forall s. ST s (MVector s a)) -> Vector a +{-# INLINE create #-} +-- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 +create p = G.create p + +-- | Execute the monadic action and freeze the resulting vectors. +createT :: (Traversable f, Prim a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + +-- Restricting memory usage +-- ------------------------ + +-- | /O(n)/ Yield the argument but force it not to retain any extra memory, +-- possibly by copying it. +-- +-- This is especially useful when dealing with slices. For example: +-- +-- > force (slice 0 2 <huge vector>) +-- +-- Here, the slice retains a reference to the huge vector. Forcing it creates +-- a copy of just the elements that belong to the slice and allows the huge +-- vector to be garbage collected. +force :: Prim a => Vector a -> Vector a +{-# INLINE force #-} +force = G.force + +-- Bulk updates +-- ------------ + +-- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector +-- element at position @i@ by @a@. +-- +-- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> +-- +(//) :: Prim a => Vector a -- ^ initial vector (of length @m@) + -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE (//) #-} +(//) = (G.//) + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @a@ from the value vector, replace the element of the +-- initial vector at position @i@ by @a@. +-- +-- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> +-- +update_ :: Prim a + => Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector a -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE update_ #-} +update_ = G.update_ + +-- | Same as ('//') but without bounds checking. +unsafeUpd :: Prim a => Vector a -> [(Int, a)] -> Vector a +{-# INLINE unsafeUpd #-} +unsafeUpd = G.unsafeUpd + +-- | Same as 'update_' but without bounds checking. +unsafeUpdate_ :: Prim a => Vector a -> Vector Int -> Vector a -> Vector a +{-# INLINE unsafeUpdate_ #-} +unsafeUpdate_ = G.unsafeUpdate_ + +-- Accumulations +-- ------------- + +-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element +-- @a@ at position @i@ by @f a b@. +-- +-- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> +accum :: Prim a + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accum #-} +accum = G.accum + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the the value vector, +-- replace the element of the initial vector at +-- position @i@ by @f a b@. +-- +-- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> +-- +accumulate_ :: (Prim a, Prim b) + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector b -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE accumulate_ #-} +accumulate_ = G.accumulate_ + +-- | Same as 'accum' but without bounds checking. +unsafeAccum :: Prim a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a +{-# INLINE unsafeAccum #-} +unsafeAccum = G.unsafeAccum + +-- | Same as 'accumulate_' but without bounds checking. +unsafeAccumulate_ :: (Prim a, Prim b) => + (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a +{-# INLINE unsafeAccumulate_ #-} +unsafeAccumulate_ = G.unsafeAccumulate_ + +-- Permutations +-- ------------ + +-- | /O(n)/ Reverse a vector +reverse :: Prim a => Vector a -> Vector a +{-# INLINE reverse #-} +reverse = G.reverse + +-- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the +-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is +-- often much more efficient. +-- +-- > backpermute <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a> +backpermute :: Prim a => Vector a -> Vector Int -> Vector a +{-# INLINE backpermute #-} +backpermute = G.backpermute + +-- | Same as 'backpermute' but without bounds checking. +unsafeBackpermute :: Prim a => Vector a -> Vector Int -> Vector a +{-# INLINE unsafeBackpermute #-} +unsafeBackpermute = G.unsafeBackpermute + +-- Safe destructive updates +-- ------------------------ + +-- | Apply a destructive operation to a vector. The operation will be +-- performed in place if it is safe to do so and will modify a copy of the +-- vector otherwise. +-- +-- @ +-- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> +-- @ +modify :: Prim a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a +{-# INLINE modify #-} +modify p = G.modify p + +-- Mapping +-- ------- + +-- | /O(n)/ Map a function over a vector +map :: (Prim a, Prim b) => (a -> b) -> Vector a -> Vector b +{-# INLINE map #-} +map = G.map + +-- | /O(n)/ Apply a function to every element of a vector and its index +imap :: (Prim a, Prim b) => (Int -> a -> b) -> Vector a -> Vector b +{-# INLINE imap #-} +imap = G.imap + +-- | Map a function over a vector and concatenate the results. +concatMap :: (Prim a, Prim b) => (a -> Vector b) -> Vector a -> Vector b +{-# INLINE concatMap #-} +concatMap = G.concatMap + +-- Monadic mapping +-- --------------- + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results +mapM :: (Monad m, Prim a, Prim b) => (a -> m b) -> Vector a -> m (Vector b) +{-# INLINE mapM #-} +mapM = G.mapM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results +mapM_ :: (Monad m, Prim a) => (a -> m b) -> Vector a -> m () +{-# INLINE mapM_ #-} +mapM_ = G.mapM_ + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results. Equivalent to @flip 'mapM'@. +forM :: (Monad m, Prim a, Prim b) => Vector a -> (a -> m b) -> m (Vector b) +{-# INLINE forM #-} +forM = G.forM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results. Equivalent to @flip 'mapM_'@. +forM_ :: (Monad m, Prim a) => Vector a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- Zipping +-- ------- + +-- | /O(min(m,n))/ Zip two vectors with the given function. +zipWith :: (Prim a, Prim b, Prim c) + => (a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE zipWith #-} +zipWith = G.zipWith + +-- | Zip three vectors with the given function. +zipWith3 :: (Prim a, Prim b, Prim c, Prim d) + => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE zipWith3 #-} +zipWith3 = G.zipWith3 + +zipWith4 :: (Prim a, Prim b, Prim c, Prim d, Prim e) + => (a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE zipWith4 #-} +zipWith4 = G.zipWith4 + +zipWith5 :: (Prim a, Prim b, Prim c, Prim d, Prim e, + Prim f) + => (a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE zipWith5 #-} +zipWith5 = G.zipWith5 + +zipWith6 :: (Prim a, Prim b, Prim c, Prim d, Prim e, + Prim f, Prim g) + => (a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE zipWith6 #-} +zipWith6 = G.zipWith6 + +-- | /O(min(m,n))/ Zip two vectors with a function that also takes the +-- elements' indices. +izipWith :: (Prim a, Prim b, Prim c) + => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE izipWith #-} +izipWith = G.izipWith + +-- | Zip three vectors and their indices with the given function. +izipWith3 :: (Prim a, Prim b, Prim c, Prim d) + => (Int -> a -> b -> c -> d) + -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE izipWith3 #-} +izipWith3 = G.izipWith3 + +izipWith4 :: (Prim a, Prim b, Prim c, Prim d, Prim e) + => (Int -> a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE izipWith4 #-} +izipWith4 = G.izipWith4 + +izipWith5 :: (Prim a, Prim b, Prim c, Prim d, Prim e, + Prim f) + => (Int -> a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE izipWith5 #-} +izipWith5 = G.izipWith5 + +izipWith6 :: (Prim a, Prim b, Prim c, Prim d, Prim e, + Prim f, Prim g) + => (Int -> a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE izipWith6 #-} +izipWith6 = G.izipWith6 + +-- Monadic zipping +-- --------------- + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a +-- vector of results +zipWithM :: (Monad m, Prim a, Prim b, Prim c) + => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +{-# INLINE zipWithM #-} +zipWithM = G.zipWithM + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the +-- results +zipWithM_ :: (Monad m, Prim a, Prim b) + => (a -> b -> m c) -> Vector a -> Vector b -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ = G.zipWithM_ + +-- Filtering +-- --------- + +-- | /O(n)/ Drop elements that do not satisfy the predicate +filter :: Prim a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE filter #-} +filter = G.filter + +-- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to +-- values and their indices +ifilter :: Prim a => (Int -> a -> Bool) -> Vector a -> Vector a +{-# INLINE ifilter #-} +ifilter = G.ifilter + +-- | /O(n)/ Drop repeated adjacent elements. +uniq :: (Prim a, Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + +-- | /O(n)/ Drop elements when predicate returns Nothing +mapMaybe :: (Prim a, Prim b) => (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing +imapMaybe :: (Prim a, Prim b) => (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + +-- | /O(n)/ Drop elements that do not satisfy the monadic predicate +filterM :: (Monad m, Prim a) => (a -> m Bool) -> Vector a -> m (Vector a) +{-# INLINE filterM #-} +filterM = G.filterM + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate +-- without copying. +takeWhile :: Prim a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE takeWhile #-} +takeWhile = G.takeWhile + +-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate +-- without copying. +dropWhile :: Prim a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE dropWhile #-} +dropWhile = G.dropWhile + +-- Parititioning +-- ------------- + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. The +-- relative order of the elements is preserved at the cost of a sometimes +-- reduced performance compared to 'unstablePartition'. +partition :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE partition #-} +partition = G.partition + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. +-- The order of the elements is not preserved but the operation is often +-- faster than 'partition'. +unstablePartition :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE unstablePartition #-} +unstablePartition = G.unstablePartition + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +span :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE span #-} +span = G.span + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +break :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE break #-} +break = G.break + +-- Searching +-- --------- + +infix 4 `elem` +-- | /O(n)/ Check if the vector contains an element +elem :: (Prim a, Eq a) => a -> Vector a -> Bool +{-# INLINE elem #-} +elem = G.elem + +infix 4 `notElem` +-- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') +notElem :: (Prim a, Eq a) => a -> Vector a -> Bool +{-# INLINE notElem #-} +notElem = G.notElem + +-- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' +-- if no such element exists. +find :: Prim a => (a -> Bool) -> Vector a -> Maybe a +{-# INLINE find #-} +find = G.find + +-- | /O(n)/ Yield 'Just' the index of the first element matching the predicate +-- or 'Nothing' if no such element exists. +findIndex :: Prim a => (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndex #-} +findIndex = G.findIndex + +-- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending +-- order. +findIndices :: Prim a => (a -> Bool) -> Vector a -> Vector Int +{-# INLINE findIndices #-} +findIndices = G.findIndices + +-- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or +-- 'Nothing' if the vector does not contain the element. This is a specialised +-- version of 'findIndex'. +elemIndex :: (Prim a, Eq a) => a -> Vector a -> Maybe Int +{-# INLINE elemIndex #-} +elemIndex = G.elemIndex + +-- | /O(n)/ Yield the indices of all occurences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +elemIndices :: (Prim a, Eq a) => a -> Vector a -> Vector Int +{-# INLINE elemIndices #-} +elemIndices = G.elemIndices + +-- Folding +-- ------- + +-- | /O(n)/ Left fold +foldl :: Prim b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Left fold on non-empty vectors +foldl1 :: Prim a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1 #-} +foldl1 = G.foldl1 + +-- | /O(n)/ Left fold with strict accumulator +foldl' :: Prim b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Left fold on non-empty vectors with strict accumulator +foldl1' :: Prim a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1' #-} +foldl1' = G.foldl1' + +-- | /O(n)/ Right fold +foldr :: Prim a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Right fold on non-empty vectors +foldr1 :: Prim a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1 #-} +foldr1 = G.foldr1 + +-- | /O(n)/ Right fold with a strict accumulator +foldr' :: Prim a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Right fold on non-empty vectors with strict accumulator +foldr1' :: Prim a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1' #-} +foldr1' = G.foldr1' + +-- | /O(n)/ Left fold (function applied to each element and its index) +ifoldl :: Prim b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Left fold with strict accumulator (function applied to each element +-- and its index) +ifoldl' :: Prim b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Right fold (function applied to each element and its index) +ifoldr :: Prim a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Right fold with strict accumulator (function applied to each +-- element and its index) +ifoldr' :: Prim a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- Specialised folds +-- ----------------- + +-- | /O(n)/ Check if all elements satisfy the predicate. +all :: Prim a => (a -> Bool) -> Vector a -> Bool +{-# INLINE all #-} +all = G.all + +-- | /O(n)/ Check if any element satisfies the predicate. +any :: Prim a => (a -> Bool) -> Vector a -> Bool +{-# INLINE any #-} +any = G.any + +-- | /O(n)/ Compute the sum of the elements +sum :: (Prim a, Num a) => Vector a -> a +{-# INLINE sum #-} +sum = G.sum + +-- | /O(n)/ Compute the produce of the elements +product :: (Prim a, Num a) => Vector a -> a +{-# INLINE product #-} +product = G.product + +-- | /O(n)/ Yield the maximum element of the vector. The vector may not be +-- empty. +maximum :: (Prim a, Ord a) => Vector a -> a +{-# INLINE maximum #-} +maximum = G.maximum + +-- | /O(n)/ Yield the maximum element of the vector according to the given +-- comparison function. The vector may not be empty. +maximumBy :: Prim a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE maximumBy #-} +maximumBy = G.maximumBy + +-- | /O(n)/ Yield the minimum element of the vector. The vector may not be +-- empty. +minimum :: (Prim a, Ord a) => Vector a -> a +{-# INLINE minimum #-} +minimum = G.minimum + +-- | /O(n)/ Yield the minimum element of the vector according to the given +-- comparison function. The vector may not be empty. +minimumBy :: Prim a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE minimumBy #-} +minimumBy = G.minimumBy + +-- | /O(n)/ Yield the index of the maximum element of the vector. The vector +-- may not be empty. +maxIndex :: (Prim a, Ord a) => Vector a -> Int +{-# INLINE maxIndex #-} +maxIndex = G.maxIndex + +-- | /O(n)/ Yield the index of the maximum element of the vector according to +-- the given comparison function. The vector may not be empty. +maxIndexBy :: Prim a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE maxIndexBy #-} +maxIndexBy = G.maxIndexBy + +-- | /O(n)/ Yield the index of the minimum element of the vector. The vector +-- may not be empty. +minIndex :: (Prim a, Ord a) => Vector a -> Int +{-# INLINE minIndex #-} +minIndex = G.minIndex + +-- | /O(n)/ Yield the index of the minimum element of the vector according to +-- the given comparison function. The vector may not be empty. +minIndexBy :: Prim a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE minIndexBy #-} +minIndexBy = G.minIndexBy + +-- Monadic folds +-- ------------- + +-- | /O(n)/ Monadic fold +foldM :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold over non-empty vectors +fold1M :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M #-} +fold1M = G.fold1M + +-- | /O(n)/ Monadic fold with strict accumulator +foldM' :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +fold1M' :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M' #-} +fold1M' = G.fold1M' + +-- | /O(n)/ Monadic fold that discards the result +foldM_ :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold over non-empty vectors that discards the result +fold1M_ :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +foldM'_ :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +-- that discards the result +fold1M'_ :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + +-- Prefix sums (scans) +-- ------------------- + +-- | /O(n)/ Prescan +-- +-- @ +-- prescanl f z = 'init' . 'scanl' f z +-- @ +-- +-- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ +-- +prescanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl #-} +prescanl = G.prescanl + +-- | /O(n)/ Prescan with strict accumulator +prescanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl' #-} +prescanl' = G.prescanl' + +-- | /O(n)/ Scan +-- +-- @ +-- postscanl f z = 'tail' . 'scanl' f z +-- @ +-- +-- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ +-- +postscanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl #-} +postscanl = G.postscanl + +-- | /O(n)/ Scan with strict accumulator +postscanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl' #-} +postscanl' = G.postscanl' + +-- | /O(n)/ Haskell-style scan +-- +-- > scanl f z <x1,...,xn> = <y1,...,y(n+1)> +-- > where y1 = z +-- > yi = f y(i-1) x(i-1) +-- +-- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@ +-- +scanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl #-} +scanl = G.scanl + +-- | /O(n)/ Haskell-style scan with strict accumulator +scanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl' #-} +scanl' = G.scanl' + +-- | /O(n)/ Scan over a non-empty vector +-- +-- > scanl f <x1,...,xn> = <y1,...,yn> +-- > where y1 = x1 +-- > yi = f y(i-1) xi +-- +scanl1 :: Prim a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1 #-} +scanl1 = G.scanl1 + +-- | /O(n)/ Scan over a non-empty vector with a strict accumulator +scanl1' :: Prim a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1' #-} +scanl1' = G.scanl1' + +-- | /O(n)/ Right-to-left prescan +-- +-- @ +-- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' +-- @ +-- +prescanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr #-} +prescanr = G.prescanr + +-- | /O(n)/ Right-to-left prescan with strict accumulator +prescanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr' #-} +prescanr' = G.prescanr' + +-- | /O(n)/ Right-to-left scan +postscanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr #-} +postscanr = G.postscanr + +-- | /O(n)/ Right-to-left scan with strict accumulator +postscanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr' #-} +postscanr' = G.postscanr' + +-- | /O(n)/ Right-to-left Haskell-style scan +scanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr #-} +scanr = G.scanr + +-- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator +scanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr' #-} +scanr' = G.scanr' + +-- | /O(n)/ Right-to-left scan over a non-empty vector +scanr1 :: Prim a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1 #-} +scanr1 = G.scanr1 + +-- | /O(n)/ Right-to-left scan over a non-empty vector with a strict +-- accumulator +scanr1' :: Prim a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1' #-} +scanr1' = G.scanr1' + +-- Conversions - Lists +-- ------------------------ + +-- | /O(n)/ Convert a vector to a list +toList :: Prim a => Vector a -> [a] +{-# INLINE toList #-} +toList = G.toList + +-- | /O(n)/ Convert a list to a vector +fromList :: Prim a => [a] -> Vector a +{-# INLINE fromList #-} +fromList = G.fromList + +-- | /O(n)/ Convert the first @n@ elements of a list to a vector +-- +-- @ +-- fromListN n xs = 'fromList' ('take' n xs) +-- @ +fromListN :: Prim a => Int -> [a] -> Vector a +{-# INLINE fromListN #-} +fromListN = G.fromListN + +-- Conversions - Mutable vectors +-- ----------------------------- + +-- | /O(1)/ Unsafe convert a mutable vector to an immutable one without +-- copying. The mutable vector may not be used after this operation. +unsafeFreeze :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE unsafeFreeze #-} +unsafeFreeze = G.unsafeFreeze + +-- | /O(1)/ Unsafely convert an immutable vector to a mutable one without +-- copying. The immutable vector may not be used after this operation. +unsafeThaw :: (Prim a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE unsafeThaw #-} +unsafeThaw = G.unsafeThaw + +-- | /O(n)/ Yield a mutable copy of the immutable vector. +thaw :: (Prim a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE thaw #-} +thaw = G.thaw + +-- | /O(n)/ Yield an immutable copy of the mutable vector. +freeze :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE freeze #-} +freeze = G.freeze + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. This is not checked. +unsafeCopy + :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. +copy :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () +{-# INLINE copy #-} +copy = G.copy diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Primitive/Mutable.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Primitive/Mutable.hs new file mode 100644 index 0000000000..33aca812e2 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Primitive/Mutable.hs @@ -0,0 +1,366 @@ +{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-} + +-- | +-- Module : Data.Vector.Primitive.Mutable +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Mutable primitive vectors. +-- + +module Data.Vector.Primitive.Mutable ( + -- * Mutable vectors of primitive types + MVector(..), IOVector, STVector, Prim, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, clone, + + -- ** Growing + grow, unsafeGrow, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, write, modify, swap, + unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, + + -- * Modifying vectors + nextPermutation, + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove +) where + +import qualified Data.Vector.Generic.Mutable as G +import Data.Primitive.ByteArray +import Data.Primitive ( Prim, sizeOf ) +import Data.Word ( Word8 ) +import Control.Monad.Primitive +import Control.Monad ( liftM ) + +import Control.DeepSeq ( NFData(rnf) ) + +import Prelude hiding ( length, null, replicate, reverse, map, read, + take, drop, splitAt, init, tail ) + +import Data.Typeable ( Typeable ) + +-- Data.Vector.Internal.Check is unnecessary +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- | Mutable vectors of primitive types. +data MVector s a = MVector {-# UNPACK #-} !Int + {-# UNPACK #-} !Int + {-# UNPACK #-} !(MutableByteArray s) -- ^ offset, length, underlying mutable byte array + deriving ( Typeable ) + +type IOVector = MVector RealWorld +type STVector s = MVector s + +instance NFData (MVector s a) where + rnf (MVector _ _ _) = () + +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 to 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 +-- ------------------ + +-- | Length of the mutable vector. +length :: Prim a => MVector s a -> Int +{-# INLINE length #-} +length = G.length + +-- | Check whether the vector is empty +null :: Prim a => MVector s a -> Bool +{-# INLINE null #-} +null = G.null + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. +slice :: Prim a => Int -> Int -> MVector s a -> MVector s a +{-# INLINE slice #-} +slice = G.slice + +take :: Prim a => Int -> MVector s a -> MVector s a +{-# INLINE take #-} +take = G.take + +drop :: Prim a => Int -> MVector s a -> MVector s a +{-# INLINE drop #-} +drop = G.drop + +splitAt :: Prim a => Int -> MVector s a -> (MVector s a, MVector s a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +init :: Prim a => MVector s a -> MVector s a +{-# INLINE init #-} +init = G.init + +tail :: Prim a => MVector s a -> MVector s a +{-# INLINE tail #-} +tail = G.tail + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +unsafeSlice :: Prim a + => Int -- ^ starting index + -> Int -- ^ length of the slice + -> MVector s a + -> MVector s a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +unsafeTake :: Prim a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +unsafeDrop :: Prim a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +unsafeInit :: Prim a => MVector s a -> MVector s a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +unsafeTail :: Prim a => MVector s a -> MVector s a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +overlaps :: Prim a => MVector s a -> MVector s a -> Bool +{-# INLINE overlaps #-} +overlaps = G.overlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +new :: (PrimMonad m, Prim a) => Int -> m (MVector (PrimState m) a) +{-# INLINE new #-} +new = G.new + +-- | Create a mutable vector of the given length. The memory is not initialized. +unsafeNew :: (PrimMonad m, Prim a) => Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew = G.unsafeNew + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +replicate :: (PrimMonad m, Prim a) => Int -> a -> m (MVector (PrimState m) a) +{-# INLINE replicate #-} +replicate = G.replicate + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +replicateM :: (PrimMonad m, Prim a) => Int -> m a -> m (MVector (PrimState m) a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | Create a copy of a mutable vector. +clone :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -> m (MVector (PrimState m) a) +{-# INLINE clone #-} +clone = G.clone + +-- Growing +-- ------- + +-- | Grow a vector by the given number of elements. The number must be +-- positive. +grow :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE grow #-} +grow = G.grow + +-- | Grow a vector by the given number of elements. The number must be +-- positive but this is not checked. +unsafeGrow :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow = G.unsafeGrow + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- references to external objects. This is usually a noop for unboxed vectors. +clear :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> m () +{-# INLINE clear #-} +clear = G.clear + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. +read :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read = G.read + +-- | Replace the element at the given position. +write :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE write #-} +write = G.write + +-- | Modify the element at the given position. +modify :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE modify #-} +modify = G.modify + +-- | Swap the elements at the given positions. +swap :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap = G.swap + + +-- | Yield the element at the given position. No bounds checks are performed. +unsafeRead :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +unsafeRead = G.unsafeRead + +-- | Replace the element at the given position. No bounds checks are performed. +unsafeWrite + :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE unsafeWrite #-} +unsafeWrite = G.unsafeWrite + +-- | Modify the element at the given position. No bounds checks are performed. +unsafeModify :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE unsafeModify #-} +unsafeModify = G.unsafeModify + +-- | Swap the elements at the given positions. No bounds checks are performed. +unsafeSwap + :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE unsafeSwap #-} +unsafeSwap = G.unsafeSwap + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +set :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> a -> m () +{-# INLINE set #-} +set = G.set + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +copy :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE copy #-} +copy = G.copy + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. This is not checked. +unsafeCopy :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | Move the contents of a vector. The two vectors must have the same +-- length. +-- +-- If the vectors do not overlap, then this is equivalent to 'copy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +move :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -> MVector (PrimState m) a -> m () +{-# INLINE move #-} +move = G.move + +-- | Move the contents of a vector. The two vectors must have the same +-- length, but this is not checked. +-- +-- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +unsafeMove :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove = G.unsafeMove + +-- | Compute the next (lexicographically) permutation of given vector in-place. +-- Returns False when input is the last permtuation +nextPermutation :: (PrimMonad m,Ord e,Prim e) => MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutation #-} +nextPermutation = G.nextPermutation diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable.hs new file mode 100644 index 0000000000..30c9a4615c --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable.hs @@ -0,0 +1,1489 @@ +{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, Rank2Types, ScopedTypeVariables #-} + +-- | +-- Module : Data.Vector.Storable +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- 'Storable'-based vectors. +-- + +module Data.Vector.Storable ( + -- * Storable vectors + Vector, MVector(..), Storable, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + unsafeIndex, unsafeHead, unsafeLast, + + -- ** Monadic indexing + indexM, headM, lastM, + unsafeIndexM, unsafeHeadM, unsafeLastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, iterateNM, create, createT, + + -- ** Unfolding + unfoldr, unfoldrN, + unfoldrM, unfoldrNM, + constructN, constructrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update_, + unsafeUpd, unsafeUpdate_, + + -- ** Accumulations + accum, accumulate_, + unsafeAccum, unsafeAccumulate_, + + -- ** Permutations + reverse, backpermute, unsafeBackpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, mapM_, forM, forM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + + -- ** Monadic zipping + zipWithM, zipWithM_, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, uniq, + mapMaybe, imapMaybe, + filterM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, span, break, + + -- ** Searching + elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + + -- ** Specialised folds + all, any, and, or, + sum, product, + maximum, maximumBy, minimum, minimumBy, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, foldM', fold1M, fold1M', + foldM_, foldM'_, fold1M_, fold1M'_, + + -- * Prefix sums (scans) + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Other vector types + G.convert, unsafeCast, + + -- ** Mutable vectors + freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy, + + -- * Raw pointers + unsafeFromForeignPtr, unsafeFromForeignPtr0, + unsafeToForeignPtr, unsafeToForeignPtr0, + unsafeWith +) where + +import qualified Data.Vector.Generic as G +import Data.Vector.Storable.Mutable ( MVector(..) ) +import Data.Vector.Storable.Internal +import qualified Data.Vector.Fusion.Bundle as Bundle + +import Foreign.Storable +import Foreign.ForeignPtr +import Foreign.Ptr +import Foreign.Marshal.Array ( advancePtr, copyArray ) + +import Control.DeepSeq ( NFData(rnf) ) + +import Control.Monad.ST ( ST ) +import Control.Monad.Primitive + +import Prelude hiding ( length, null, + replicate, (++), concat, + head, last, + init, tail, take, drop, splitAt, reverse, + map, concatMap, + zipWith, zipWith3, zip, zip3, unzip, unzip3, + filter, takeWhile, dropWhile, span, break, + elem, notElem, + foldl, foldl1, foldr, foldr1, + all, any, and, or, sum, product, minimum, maximum, + scanl, scanl1, scanr, scanr1, + enumFromTo, enumFromThenTo, + mapM, mapM_ ) + +import Data.Typeable ( Typeable ) +import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) +import Data.Semigroup ( Semigroup(..) ) + +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid ( Monoid(..) ) +import Data.Traversable ( Traversable ) +#endif + +#if __GLASGOW_HASKELL__ >= 708 +import qualified GHC.Exts as Exts +#endif + +-- Data.Vector.Internal.Check is unused +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- | 'Storable'-based vectors +data Vector a = Vector {-# UNPACK #-} !Int + {-# UNPACK #-} !(ForeignPtr a) + deriving ( Typeable ) + +instance NFData (Vector a) where + rnf (Vector _ _) = () + +instance (Show a, Storable a) => Show (Vector a) where + showsPrec = G.showsPrec + +instance (Read a, Storable a) => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + +instance (Data a, Storable a) => Data (Vector a) where + gfoldl = G.gfoldl + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = G.mkType "Data.Vector.Storable.Vector" + dataCast1 = G.dataCast + +type instance G.Mutable Vector = MVector + +instance Storable a => G.Vector Vector a where + {-# INLINE basicUnsafeFreeze #-} + basicUnsafeFreeze (MVector n fp) = return $ Vector n fp + + {-# INLINE basicUnsafeThaw #-} + basicUnsafeThaw (Vector n fp) = return $ MVector n fp + + {-# INLINE basicLength #-} + basicLength (Vector n _) = n + + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice i n (Vector _ fp) = Vector n (updPtr (`advancePtr` i) fp) + + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM (Vector _ fp) i = return + . unsafeInlineIO + $ withForeignPtr fp $ \p -> + peekElemOff p i + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MVector n fp) (Vector _ fq) + = unsafePrimToPrim + $ withForeignPtr fp $ \p -> + withForeignPtr fq $ \q -> + copyArray p q n + + {-# INLINE elemseq #-} + elemseq _ = seq + +-- See http://trac.haskell.org/vector/ticket/12 +instance (Storable a, Eq a) => Eq (Vector a) where + {-# INLINE (==) #-} + xs == ys = Bundle.eq (G.stream xs) (G.stream ys) + + {-# INLINE (/=) #-} + xs /= ys = not (Bundle.eq (G.stream xs) (G.stream ys)) + +-- See http://trac.haskell.org/vector/ticket/12 +instance (Storable 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 Storable a => Semigroup (Vector a) where + {-# INLINE (<>) #-} + (<>) = (++) + + {-# INLINE sconcat #-} + sconcat = G.concatNE + +instance Storable a => Monoid (Vector a) where + {-# INLINE mempty #-} + mempty = empty + + {-# INLINE mappend #-} + mappend = (++) + + {-# INLINE mconcat #-} + mconcat = concat + +#if __GLASGOW_HASKELL__ >= 708 + +instance Storable a => Exts.IsList (Vector a) where + type Item (Vector a) = a + fromList = fromList + fromListN = fromListN + toList = toList + +#endif + +-- Length +-- ------ + +-- | /O(1)/ Yield the length of the vector +length :: Storable a => Vector a -> Int +{-# INLINE length #-} +length = G.length + +-- | /O(1)/ Test whether a vector is empty +null :: Storable a => Vector a -> Bool +{-# INLINE null #-} +null = G.null + +-- Indexing +-- -------- + +-- | O(1) Indexing +(!) :: Storable a => Vector a -> Int -> a +{-# INLINE (!) #-} +(!) = (G.!) + +-- | O(1) Safe indexing +(!?) :: Storable a => Vector a -> Int -> Maybe a +{-# INLINE (!?) #-} +(!?) = (G.!?) + +-- | /O(1)/ First element +head :: Storable a => Vector a -> a +{-# INLINE head #-} +head = G.head + +-- | /O(1)/ Last element +last :: Storable a => Vector a -> a +{-# INLINE last #-} +last = G.last + +-- | /O(1)/ Unsafe indexing without bounds checking +unsafeIndex :: Storable a => Vector a -> Int -> a +{-# INLINE unsafeIndex #-} +unsafeIndex = G.unsafeIndex + +-- | /O(1)/ First element without checking if the vector is empty +unsafeHead :: Storable a => Vector a -> a +{-# INLINE unsafeHead #-} +unsafeHead = G.unsafeHead + +-- | /O(1)/ Last element without checking if the vector is empty +unsafeLast :: Storable a => Vector a -> a +{-# INLINE unsafeLast #-} +unsafeLast = G.unsafeLast + +-- Monadic indexing +-- ---------------- + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the vector when necessary. +-- Suppose vector copying is implemented like this: +-- +-- > copy mv v = ... write mv i (v ! i) ... +-- +-- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ +-- would unnecessarily retain a reference to @v@ in each element written. +-- +-- With 'indexM', copying can be implemented like this instead: +-- +-- > copy mv v = ... do +-- > x <- indexM v i +-- > write mv i x +-- +-- Here, no references to @v@ are retained because indexing (but /not/ the +-- elements) is evaluated eagerly. +-- +indexM :: (Storable a, Monad m) => Vector a -> Int -> m a +{-# INLINE indexM #-} +indexM = G.indexM + +-- | /O(1)/ First element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +headM :: (Storable a, Monad m) => Vector a -> m a +{-# INLINE headM #-} +headM = G.headM + +-- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +lastM :: (Storable a, Monad m) => Vector a -> m a +{-# INLINE lastM #-} +lastM = G.lastM + +-- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an +-- explanation of why this is useful. +unsafeIndexM :: (Storable a, Monad m) => Vector a -> Int -> m a +{-# INLINE unsafeIndexM #-} +unsafeIndexM = G.unsafeIndexM + +-- | /O(1)/ First element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeHeadM :: (Storable a, Monad m) => Vector a -> m a +{-# INLINE unsafeHeadM #-} +unsafeHeadM = G.unsafeHeadM + +-- | /O(1)/ Last element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeLastM :: (Storable a, Monad m) => Vector a -> m a +{-# INLINE unsafeLastM #-} +unsafeLastM = G.unsafeLastM + +-- Extracting subvectors (slicing) +-- ------------------------------- + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Storable a + => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE slice #-} +slice = G.slice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty. +init :: Storable a => Vector a -> Vector a +{-# INLINE init #-} +init = G.init + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty. +tail :: Storable a => Vector a -> Vector a +{-# INLINE tail #-} +tail = G.tail + +-- | /O(1)/ Yield at the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case it is returned unchanged. +take :: Storable a => Int -> Vector a -> Vector a +{-# INLINE take #-} +take = G.take + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case an empty vector is returned. +drop :: Storable a => Int -> Vector a -> Vector a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ +-- but slightly more efficient. +{-# INLINE splitAt #-} +splitAt :: Storable a => Int -> Vector a -> (Vector a, Vector a) +splitAt = G.splitAt + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must +-- contain at least @i+n@ elements but this is not checked. +unsafeSlice :: Storable a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty but this is not checked. +unsafeInit :: Storable a => Vector a -> Vector a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty but this is not checked. +unsafeTail :: Storable a => Vector a -> Vector a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector must +-- contain at least @n@ elements but this is not checked. +unsafeTake :: Storable a => Int -> Vector a -> Vector a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector +-- must contain at least @n@ elements but this is not checked. +unsafeDrop :: Storable a => Int -> Vector a -> Vector a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- Initialisation +-- -------------- + +-- | /O(1)/ Empty vector +empty :: Storable a => Vector a +{-# INLINE empty #-} +empty = G.empty + +-- | /O(1)/ Vector with exactly one element +singleton :: Storable a => a -> Vector a +{-# INLINE singleton #-} +singleton = G.singleton + +-- | /O(n)/ Vector of the given length with the same value in each position +replicate :: Storable a => Int -> a -> Vector a +{-# INLINE replicate #-} +replicate = G.replicate + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index +generate :: Storable a => Int -> (Int -> a) -> Vector a +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Apply function n times to value. Zeroth element is original value. +iterateN :: Storable a => Int -> (a -> a) -> a -> Vector a +{-# INLINE iterateN #-} +iterateN = G.iterateN + +-- Unfolding +-- --------- + +-- | /O(n)/ Construct a vector by repeatedly applying the generator function +-- to a seed. The generator function yields 'Just' the next element and the +-- new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 +-- > = <10,9,8,7,6,5,4,3,2,1> +unfoldr :: Storable a => (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldr #-} +unfoldr = G.unfoldr + +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> +unfoldrN :: Storable a => Int -> (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldrN #-} +unfoldrN = G.unfoldrN + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Storable a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Storable a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in f <a,b,c> +-- +constructN :: Storable a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in f <c,b,a> +-- +constructrN :: Storable a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN + +-- Enumeration +-- ----------- + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ +-- etc. This operation is usually more efficient than 'enumFromTo'. +-- +-- > enumFromN 5 3 = <5,6,7> +enumFromN :: (Storable a, Num a) => a -> Int -> Vector a +{-# INLINE enumFromN #-} +enumFromN = G.enumFromN + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, +-- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. +-- +-- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> +enumFromStepN :: (Storable a, Num a) => a -> a -> Int -> Vector a +{-# INLINE enumFromStepN #-} +enumFromStepN = G.enumFromStepN + +-- | /O(n)/ Enumerate values from @x@ to @y@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromN' instead. +enumFromTo :: (Storable a, Enum a) => a -> a -> Vector a +{-# INLINE enumFromTo #-} +enumFromTo = G.enumFromTo + +-- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Storable a, Enum a) => a -> a -> a -> Vector a +{-# INLINE enumFromThenTo #-} +enumFromThenTo = G.enumFromThenTo + +-- Concatenation +-- ------------- + +-- | /O(n)/ Prepend an element +cons :: Storable a => a -> Vector a -> Vector a +{-# INLINE cons #-} +cons = G.cons + +-- | /O(n)/ Append an element +snoc :: Storable a => Vector a -> a -> Vector a +{-# INLINE snoc #-} +snoc = G.snoc + +infixr 5 ++ +-- | /O(m+n)/ Concatenate two vectors +(++) :: Storable a => Vector a -> Vector a -> Vector a +{-# INLINE (++) #-} +(++) = (G.++) + +-- | /O(n)/ Concatenate all vectors in the list +concat :: Storable a => [Vector a] -> Vector a +{-# INLINE concat #-} +concat = G.concat + +-- Monadic initialisation +-- ---------------------- + +-- | /O(n)/ Execute the monadic action the given number of times and store the +-- results in a vector. +replicateM :: (Monad m, Storable a) => Int -> m a -> m (Vector a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +generateM :: (Monad m, Storable a) => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: (Monad m, Storable a) => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + +-- | Execute the monadic action and freeze the resulting vector. +-- +-- @ +-- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> +-- @ +create :: Storable a => (forall s. ST s (MVector s a)) -> Vector a +{-# INLINE create #-} +-- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 +create p = G.create p + +-- | Execute the monadic action and freeze the resulting vectors. +createT :: (Traversable f, Storable a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + +-- Restricting memory usage +-- ------------------------ + +-- | /O(n)/ Yield the argument but force it not to retain any extra memory, +-- possibly by copying it. +-- +-- This is especially useful when dealing with slices. For example: +-- +-- > force (slice 0 2 <huge vector>) +-- +-- Here, the slice retains a reference to the huge vector. Forcing it creates +-- a copy of just the elements that belong to the slice and allows the huge +-- vector to be garbage collected. +force :: Storable a => Vector a -> Vector a +{-# INLINE force #-} +force = G.force + +-- Bulk updates +-- ------------ + +-- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector +-- element at position @i@ by @a@. +-- +-- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> +-- +(//) :: Storable a => Vector a -- ^ initial vector (of length @m@) + -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE (//) #-} +(//) = (G.//) + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @a@ from the value vector, replace the element of the +-- initial vector at position @i@ by @a@. +-- +-- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> +-- +update_ :: Storable a + => Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector a -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE update_ #-} +update_ = G.update_ + +-- | Same as ('//') but without bounds checking. +unsafeUpd :: Storable a => Vector a -> [(Int, a)] -> Vector a +{-# INLINE unsafeUpd #-} +unsafeUpd = G.unsafeUpd + +-- | Same as 'update_' but without bounds checking. +unsafeUpdate_ :: Storable a => Vector a -> Vector Int -> Vector a -> Vector a +{-# INLINE unsafeUpdate_ #-} +unsafeUpdate_ = G.unsafeUpdate_ + +-- Accumulations +-- ------------- + +-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element +-- @a@ at position @i@ by @f a b@. +-- +-- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> +accum :: Storable a + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accum #-} +accum = G.accum + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the the value vector, +-- replace the element of the initial vector at +-- position @i@ by @f a b@. +-- +-- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> +-- +accumulate_ :: (Storable a, Storable b) + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector b -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE accumulate_ #-} +accumulate_ = G.accumulate_ + +-- | Same as 'accum' but without bounds checking. +unsafeAccum :: Storable a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a +{-# INLINE unsafeAccum #-} +unsafeAccum = G.unsafeAccum + +-- | Same as 'accumulate_' but without bounds checking. +unsafeAccumulate_ :: (Storable a, Storable b) => + (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a +{-# INLINE unsafeAccumulate_ #-} +unsafeAccumulate_ = G.unsafeAccumulate_ + +-- Permutations +-- ------------ + +-- | /O(n)/ Reverse a vector +reverse :: Storable a => Vector a -> Vector a +{-# INLINE reverse #-} +reverse = G.reverse + +-- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the +-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is +-- often much more efficient. +-- +-- > backpermute <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a> +backpermute :: Storable a => Vector a -> Vector Int -> Vector a +{-# INLINE backpermute #-} +backpermute = G.backpermute + +-- | Same as 'backpermute' but without bounds checking. +unsafeBackpermute :: Storable a => Vector a -> Vector Int -> Vector a +{-# INLINE unsafeBackpermute #-} +unsafeBackpermute = G.unsafeBackpermute + +-- Safe destructive updates +-- ------------------------ + +-- | Apply a destructive operation to a vector. The operation will be +-- performed in place if it is safe to do so and will modify a copy of the +-- vector otherwise. +-- +-- @ +-- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> +-- @ +modify :: Storable a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a +{-# INLINE modify #-} +modify p = G.modify p + +-- Mapping +-- ------- + +-- | /O(n)/ Map a function over a vector +map :: (Storable a, Storable b) => (a -> b) -> Vector a -> Vector b +{-# INLINE map #-} +map = G.map + +-- | /O(n)/ Apply a function to every element of a vector and its index +imap :: (Storable a, Storable b) => (Int -> a -> b) -> Vector a -> Vector b +{-# INLINE imap #-} +imap = G.imap + +-- | Map a function over a vector and concatenate the results. +concatMap :: (Storable a, Storable b) => (a -> Vector b) -> Vector a -> Vector b +{-# INLINE concatMap #-} +concatMap = G.concatMap + +-- Monadic mapping +-- --------------- + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results +mapM :: (Monad m, Storable a, Storable b) => (a -> m b) -> Vector a -> m (Vector b) +{-# INLINE mapM #-} +mapM = G.mapM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results +mapM_ :: (Monad m, Storable a) => (a -> m b) -> Vector a -> m () +{-# INLINE mapM_ #-} +mapM_ = G.mapM_ + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results. Equivalent to @flip 'mapM'@. +forM :: (Monad m, Storable a, Storable b) => Vector a -> (a -> m b) -> m (Vector b) +{-# INLINE forM #-} +forM = G.forM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results. Equivalent to @flip 'mapM_'@. +forM_ :: (Monad m, Storable a) => Vector a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- Zipping +-- ------- + +-- | /O(min(m,n))/ Zip two vectors with the given function. +zipWith :: (Storable a, Storable b, Storable c) + => (a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE zipWith #-} +zipWith = G.zipWith + +-- | Zip three vectors with the given function. +zipWith3 :: (Storable a, Storable b, Storable c, Storable d) + => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE zipWith3 #-} +zipWith3 = G.zipWith3 + +zipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) + => (a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE zipWith4 #-} +zipWith4 = G.zipWith4 + +zipWith5 :: (Storable a, Storable b, Storable c, Storable d, Storable e, + Storable f) + => (a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE zipWith5 #-} +zipWith5 = G.zipWith5 + +zipWith6 :: (Storable a, Storable b, Storable c, Storable d, Storable e, + Storable f, Storable g) + => (a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE zipWith6 #-} +zipWith6 = G.zipWith6 + +-- | /O(min(m,n))/ Zip two vectors with a function that also takes the +-- elements' indices. +izipWith :: (Storable a, Storable b, Storable c) + => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE izipWith #-} +izipWith = G.izipWith + +-- | Zip three vectors and their indices with the given function. +izipWith3 :: (Storable a, Storable b, Storable c, Storable d) + => (Int -> a -> b -> c -> d) + -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE izipWith3 #-} +izipWith3 = G.izipWith3 + +izipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) + => (Int -> a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE izipWith4 #-} +izipWith4 = G.izipWith4 + +izipWith5 :: (Storable a, Storable b, Storable c, Storable d, Storable e, + Storable f) + => (Int -> a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE izipWith5 #-} +izipWith5 = G.izipWith5 + +izipWith6 :: (Storable a, Storable b, Storable c, Storable d, Storable e, + Storable f, Storable g) + => (Int -> a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE izipWith6 #-} +izipWith6 = G.izipWith6 + +-- Monadic zipping +-- --------------- + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a +-- vector of results +zipWithM :: (Monad m, Storable a, Storable b, Storable c) + => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +{-# INLINE zipWithM #-} +zipWithM = G.zipWithM + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the +-- results +zipWithM_ :: (Monad m, Storable a, Storable b) + => (a -> b -> m c) -> Vector a -> Vector b -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ = G.zipWithM_ + +-- Filtering +-- --------- + +-- | /O(n)/ Drop elements that do not satisfy the predicate +filter :: Storable a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE filter #-} +filter = G.filter + +-- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to +-- values and their indices +ifilter :: Storable a => (Int -> a -> Bool) -> Vector a -> Vector a +{-# INLINE ifilter #-} +ifilter = G.ifilter + +-- | /O(n)/ Drop repeated adjacent elements. +uniq :: (Storable a, Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + +-- | /O(n)/ Drop elements when predicate returns Nothing +mapMaybe :: (Storable a, Storable b) => (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing +imapMaybe :: (Storable a, Storable b) => (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + +-- | /O(n)/ Drop elements that do not satisfy the monadic predicate +filterM :: (Monad m, Storable a) => (a -> m Bool) -> Vector a -> m (Vector a) +{-# INLINE filterM #-} +filterM = G.filterM + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate +-- without copying. +takeWhile :: Storable a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE takeWhile #-} +takeWhile = G.takeWhile + +-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate +-- without copying. +dropWhile :: Storable a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE dropWhile #-} +dropWhile = G.dropWhile + +-- Parititioning +-- ------------- + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. The +-- relative order of the elements is preserved at the cost of a sometimes +-- reduced performance compared to 'unstablePartition'. +partition :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE partition #-} +partition = G.partition + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. +-- The order of the elements is not preserved but the operation is often +-- faster than 'partition'. +unstablePartition :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE unstablePartition #-} +unstablePartition = G.unstablePartition + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +span :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE span #-} +span = G.span + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +break :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE break #-} +break = G.break + +-- Searching +-- --------- + +infix 4 `elem` +-- | /O(n)/ Check if the vector contains an element +elem :: (Storable a, Eq a) => a -> Vector a -> Bool +{-# INLINE elem #-} +elem = G.elem + +infix 4 `notElem` +-- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') +notElem :: (Storable a, Eq a) => a -> Vector a -> Bool +{-# INLINE notElem #-} +notElem = G.notElem + +-- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' +-- if no such element exists. +find :: Storable a => (a -> Bool) -> Vector a -> Maybe a +{-# INLINE find #-} +find = G.find + +-- | /O(n)/ Yield 'Just' the index of the first element matching the predicate +-- or 'Nothing' if no such element exists. +findIndex :: Storable a => (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndex #-} +findIndex = G.findIndex + +-- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending +-- order. +findIndices :: Storable a => (a -> Bool) -> Vector a -> Vector Int +{-# INLINE findIndices #-} +findIndices = G.findIndices + +-- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or +-- 'Nothing' if the vector does not contain the element. This is a specialised +-- version of 'findIndex'. +elemIndex :: (Storable a, Eq a) => a -> Vector a -> Maybe Int +{-# INLINE elemIndex #-} +elemIndex = G.elemIndex + +-- | /O(n)/ Yield the indices of all occurences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +elemIndices :: (Storable a, Eq a) => a -> Vector a -> Vector Int +{-# INLINE elemIndices #-} +elemIndices = G.elemIndices + +-- Folding +-- ------- + +-- | /O(n)/ Left fold +foldl :: Storable b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Left fold on non-empty vectors +foldl1 :: Storable a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1 #-} +foldl1 = G.foldl1 + +-- | /O(n)/ Left fold with strict accumulator +foldl' :: Storable b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Left fold on non-empty vectors with strict accumulator +foldl1' :: Storable a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1' #-} +foldl1' = G.foldl1' + +-- | /O(n)/ Right fold +foldr :: Storable a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Right fold on non-empty vectors +foldr1 :: Storable a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1 #-} +foldr1 = G.foldr1 + +-- | /O(n)/ Right fold with a strict accumulator +foldr' :: Storable a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Right fold on non-empty vectors with strict accumulator +foldr1' :: Storable a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1' #-} +foldr1' = G.foldr1' + +-- | /O(n)/ Left fold (function applied to each element and its index) +ifoldl :: Storable b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Left fold with strict accumulator (function applied to each element +-- and its index) +ifoldl' :: Storable b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Right fold (function applied to each element and its index) +ifoldr :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Right fold with strict accumulator (function applied to each +-- element and its index) +ifoldr' :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- Specialised folds +-- ----------------- + +-- | /O(n)/ Check if all elements satisfy the predicate. +all :: Storable a => (a -> Bool) -> Vector a -> Bool +{-# INLINE all #-} +all = G.all + +-- | /O(n)/ Check if any element satisfies the predicate. +any :: Storable a => (a -> Bool) -> Vector a -> Bool +{-# INLINE any #-} +any = G.any + +-- | /O(n)/ Check if all elements are 'True' +and :: Vector Bool -> Bool +{-# INLINE and #-} +and = G.and + +-- | /O(n)/ Check if any element is 'True' +or :: Vector Bool -> Bool +{-# INLINE or #-} +or = G.or + +-- | /O(n)/ Compute the sum of the elements +sum :: (Storable a, Num a) => Vector a -> a +{-# INLINE sum #-} +sum = G.sum + +-- | /O(n)/ Compute the produce of the elements +product :: (Storable a, Num a) => Vector a -> a +{-# INLINE product #-} +product = G.product + +-- | /O(n)/ Yield the maximum element of the vector. The vector may not be +-- empty. +maximum :: (Storable a, Ord a) => Vector a -> a +{-# INLINE maximum #-} +maximum = G.maximum + +-- | /O(n)/ Yield the maximum element of the vector according to the given +-- comparison function. The vector may not be empty. +maximumBy :: Storable a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE maximumBy #-} +maximumBy = G.maximumBy + +-- | /O(n)/ Yield the minimum element of the vector. The vector may not be +-- empty. +minimum :: (Storable a, Ord a) => Vector a -> a +{-# INLINE minimum #-} +minimum = G.minimum + +-- | /O(n)/ Yield the minimum element of the vector according to the given +-- comparison function. The vector may not be empty. +minimumBy :: Storable a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE minimumBy #-} +minimumBy = G.minimumBy + +-- | /O(n)/ Yield the index of the maximum element of the vector. The vector +-- may not be empty. +maxIndex :: (Storable a, Ord a) => Vector a -> Int +{-# INLINE maxIndex #-} +maxIndex = G.maxIndex + +-- | /O(n)/ Yield the index of the maximum element of the vector according to +-- the given comparison function. The vector may not be empty. +maxIndexBy :: Storable a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE maxIndexBy #-} +maxIndexBy = G.maxIndexBy + +-- | /O(n)/ Yield the index of the minimum element of the vector. The vector +-- may not be empty. +minIndex :: (Storable a, Ord a) => Vector a -> Int +{-# INLINE minIndex #-} +minIndex = G.minIndex + +-- | /O(n)/ Yield the index of the minimum element of the vector according to +-- the given comparison function. The vector may not be empty. +minIndexBy :: Storable a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE minIndexBy #-} +minIndexBy = G.minIndexBy + +-- Monadic folds +-- ------------- + +-- | /O(n)/ Monadic fold +foldM :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold over non-empty vectors +fold1M :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M #-} +fold1M = G.fold1M + +-- | /O(n)/ Monadic fold with strict accumulator +foldM' :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +fold1M' :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M' #-} +fold1M' = G.fold1M' + +-- | /O(n)/ Monadic fold that discards the result +foldM_ :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold over non-empty vectors that discards the result +fold1M_ :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +foldM'_ :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +-- that discards the result +fold1M'_ :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + +-- Prefix sums (scans) +-- ------------------- + +-- | /O(n)/ Prescan +-- +-- @ +-- prescanl f z = 'init' . 'scanl' f z +-- @ +-- +-- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ +-- +prescanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl #-} +prescanl = G.prescanl + +-- | /O(n)/ Prescan with strict accumulator +prescanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl' #-} +prescanl' = G.prescanl' + +-- | /O(n)/ Scan +-- +-- @ +-- postscanl f z = 'tail' . 'scanl' f z +-- @ +-- +-- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ +-- +postscanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl #-} +postscanl = G.postscanl + +-- | /O(n)/ Scan with strict accumulator +postscanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl' #-} +postscanl' = G.postscanl' + +-- | /O(n)/ Haskell-style scan +-- +-- > scanl f z <x1,...,xn> = <y1,...,y(n+1)> +-- > where y1 = z +-- > yi = f y(i-1) x(i-1) +-- +-- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@ +-- +scanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl #-} +scanl = G.scanl + +-- | /O(n)/ Haskell-style scan with strict accumulator +scanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl' #-} +scanl' = G.scanl' + +-- | /O(n)/ Scan over a non-empty vector +-- +-- > scanl f <x1,...,xn> = <y1,...,yn> +-- > where y1 = x1 +-- > yi = f y(i-1) xi +-- +scanl1 :: Storable a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1 #-} +scanl1 = G.scanl1 + +-- | /O(n)/ Scan over a non-empty vector with a strict accumulator +scanl1' :: Storable a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1' #-} +scanl1' = G.scanl1' + +-- | /O(n)/ Right-to-left prescan +-- +-- @ +-- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' +-- @ +-- +prescanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr #-} +prescanr = G.prescanr + +-- | /O(n)/ Right-to-left prescan with strict accumulator +prescanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr' #-} +prescanr' = G.prescanr' + +-- | /O(n)/ Right-to-left scan +postscanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr #-} +postscanr = G.postscanr + +-- | /O(n)/ Right-to-left scan with strict accumulator +postscanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr' #-} +postscanr' = G.postscanr' + +-- | /O(n)/ Right-to-left Haskell-style scan +scanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr #-} +scanr = G.scanr + +-- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator +scanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr' #-} +scanr' = G.scanr' + +-- | /O(n)/ Right-to-left scan over a non-empty vector +scanr1 :: Storable a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1 #-} +scanr1 = G.scanr1 + +-- | /O(n)/ Right-to-left scan over a non-empty vector with a strict +-- accumulator +scanr1' :: Storable a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1' #-} +scanr1' = G.scanr1' + +-- Conversions - Lists +-- ------------------------ + +-- | /O(n)/ Convert a vector to a list +toList :: Storable a => Vector a -> [a] +{-# INLINE toList #-} +toList = G.toList + +-- | /O(n)/ Convert a list to a vector +fromList :: Storable a => [a] -> Vector a +{-# INLINE fromList #-} +fromList = G.fromList + +-- | /O(n)/ Convert the first @n@ elements of a list to a vector +-- +-- @ +-- fromListN n xs = 'fromList' ('take' n xs) +-- @ +fromListN :: Storable a => Int -> [a] -> Vector a +{-# INLINE fromListN #-} +fromListN = G.fromListN + +-- Conversions - Unsafe casts +-- -------------------------- + +-- | /O(1)/ Unsafely cast a vector from one element type to another. +-- The operation just changes the type of the underlying pointer and does not +-- modify the elements. +-- +-- The resulting vector contains as many elements as can fit into the +-- underlying memory block. +-- +unsafeCast :: forall a b. (Storable a, Storable b) => Vector a -> Vector b +{-# INLINE unsafeCast #-} +unsafeCast (Vector n fp) + = Vector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) + (castForeignPtr fp) + + +-- Conversions - Mutable vectors +-- ----------------------------- + +-- | /O(1)/ Unsafe convert a mutable vector to an immutable one without +-- copying. The mutable vector may not be used after this operation. +unsafeFreeze + :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE unsafeFreeze #-} +unsafeFreeze = G.unsafeFreeze + +-- | /O(1)/ Unsafely convert an immutable vector to a mutable one without +-- copying. The immutable vector may not be used after this operation. +unsafeThaw + :: (Storable a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE unsafeThaw #-} +unsafeThaw = G.unsafeThaw + +-- | /O(n)/ Yield a mutable copy of the immutable vector. +thaw :: (Storable a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE thaw #-} +thaw = G.thaw + +-- | /O(n)/ Yield an immutable copy of the mutable vector. +freeze :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE freeze #-} +freeze = G.freeze + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. This is not checked. +unsafeCopy + :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. +copy :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () +{-# INLINE copy #-} +copy = G.copy + +-- Conversions - Raw pointers +-- -------------------------- + +-- | /O(1)/ Create a vector from a 'ForeignPtr' with an offset and a length. +-- +-- The data may not be modified through the 'ForeignPtr' afterwards. +-- +-- If your offset is 0 it is more efficient to use 'unsafeFromForeignPtr0'. +unsafeFromForeignPtr :: Storable a + => ForeignPtr a -- ^ pointer + -> Int -- ^ offset + -> Int -- ^ length + -> Vector a +{-# INLINE_FUSED unsafeFromForeignPtr #-} +unsafeFromForeignPtr fp i n = unsafeFromForeignPtr0 fp' n + where + fp' = updPtr (`advancePtr` i) fp + +{-# RULES +"unsafeFromForeignPtr fp 0 n -> unsafeFromForeignPtr0 fp n " forall fp n. + unsafeFromForeignPtr fp 0 n = unsafeFromForeignPtr0 fp n #-} + + +-- | /O(1)/ Create a vector from a 'ForeignPtr' and a length. +-- +-- It is assumed the pointer points directly to the data (no offset). +-- Use `unsafeFromForeignPtr` if you need to specify an offset. +-- +-- The data may not be modified through the 'ForeignPtr' afterwards. +unsafeFromForeignPtr0 :: Storable a + => ForeignPtr a -- ^ pointer + -> Int -- ^ length + -> Vector a +{-# INLINE unsafeFromForeignPtr0 #-} +unsafeFromForeignPtr0 fp n = Vector n fp + +-- | /O(1)/ Yield the underlying 'ForeignPtr' together with the offset to the +-- data and its length. The data may not be modified through the 'ForeignPtr'. +unsafeToForeignPtr :: Storable a => Vector a -> (ForeignPtr a, Int, Int) +{-# INLINE unsafeToForeignPtr #-} +unsafeToForeignPtr (Vector n fp) = (fp, 0, n) + +-- | /O(1)/ Yield the underlying 'ForeignPtr' together with its length. +-- +-- You can assume the pointer points directly to the data (no offset). +-- +-- The data may not be modified through the 'ForeignPtr'. +unsafeToForeignPtr0 :: Storable a => Vector a -> (ForeignPtr a, Int) +{-# INLINE unsafeToForeignPtr0 #-} +unsafeToForeignPtr0 (Vector n fp) = (fp, n) + +-- | Pass a pointer to the vector's data to the IO action. The data may not be +-- modified through the 'Ptr. +unsafeWith :: Storable a => Vector a -> (Ptr a -> IO b) -> IO b +{-# INLINE unsafeWith #-} +unsafeWith (Vector _ fp) = withForeignPtr fp diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Internal.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Internal.hs new file mode 100644 index 0000000000..69a46d8421 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Internal.hs @@ -0,0 +1,33 @@ +-- | +-- Module : Data.Vector.Storable.Internal +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Ugly internal utility functions for implementing 'Storable'-based vectors. +-- + +module Data.Vector.Storable.Internal ( + getPtr, setPtr, updPtr +) where + +import Foreign.ForeignPtr +import Foreign.Ptr +import GHC.ForeignPtr ( ForeignPtr(..) ) +import GHC.Ptr ( Ptr(..) ) + +getPtr :: ForeignPtr a -> Ptr a +{-# INLINE getPtr #-} +getPtr (ForeignPtr addr _) = Ptr addr + +setPtr :: ForeignPtr a -> Ptr a -> ForeignPtr a +{-# INLINE setPtr #-} +setPtr (ForeignPtr _ c) (Ptr addr) = ForeignPtr addr c + +updPtr :: (Ptr a -> Ptr a) -> ForeignPtr a -> ForeignPtr a +{-# INLINE updPtr #-} +updPtr f (ForeignPtr p c) = case f (Ptr p) of { Ptr q -> ForeignPtr q c } + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Mutable.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Mutable.hs new file mode 100644 index 0000000000..29eb2fbfa3 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Mutable.hs @@ -0,0 +1,543 @@ +{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, MagicHash, MultiParamTypeClasses, ScopedTypeVariables #-} + +-- | +-- Module : Data.Vector.Storable.Mutable +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Mutable vectors based on Storable. +-- + +module Data.Vector.Storable.Mutable( + -- * Mutable vectors of 'Storable' types + MVector(..), IOVector, STVector, Storable, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, clone, + + -- ** Growing + grow, unsafeGrow, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, write, modify, swap, + unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, + + -- * Modifying vectors + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove, + + -- * Unsafe conversions + unsafeCast, + + -- * Raw pointers + unsafeFromForeignPtr, unsafeFromForeignPtr0, + unsafeToForeignPtr, unsafeToForeignPtr0, + unsafeWith +) where + +import Control.DeepSeq ( NFData(rnf) ) + +import qualified Data.Vector.Generic.Mutable as G +import Data.Vector.Storable.Internal + +import Foreign.Storable +import Foreign.ForeignPtr + +#if __GLASGOW_HASKELL__ >= 706 +import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes) +#elif __GLASGOW_HASKELL__ >= 700 +import Data.Primitive.ByteArray (MutableByteArray(..), newAlignedPinnedByteArray, + unsafeFreezeByteArray) +import GHC.Prim (byteArrayContents#, unsafeCoerce#) +import GHC.ForeignPtr +#endif + +import Foreign.Ptr +import Foreign.Marshal.Array ( advancePtr, copyArray, moveArray ) + +import Control.Monad.Primitive +import Data.Primitive.Addr +import Data.Primitive.Types (Prim) + +import GHC.Word (Word8, Word16, Word32, Word64) +import GHC.Ptr (Ptr(..)) + +import Prelude hiding ( length, null, replicate, reverse, map, read, + take, drop, splitAt, init, tail ) + +import Data.Typeable ( Typeable ) + +-- Data.Vector.Internal.Check is not needed +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- | Mutable 'Storable'-based vectors +data MVector s a = MVector {-# UNPACK #-} !Int + {-# UNPACK #-} !(ForeignPtr a) + deriving ( Typeable ) + +type IOVector = MVector RealWorld +type STVector s = MVector s + +instance NFData (MVector s a) where + rnf (MVector _ _) = () + +instance Storable a => G.MVector MVector a where + {-# INLINE basicLength #-} + basicLength (MVector n _) = n + + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice j m (MVector _ fp) = MVector m (updPtr (`advancePtr` j) fp) + + -- FIXME: this relies on non-portable pointer comparisons + {-# INLINE basicOverlaps #-} + basicOverlaps (MVector m fp) (MVector n fq) + = between p q (q `advancePtr` n) || between q p (p `advancePtr` m) + where + between x y z = x >= y && x < z + p = getPtr fp + q = getPtr fq + + {-# INLINE basicUnsafeNew #-} + basicUnsafeNew n + | n < 0 = error $ "Storable.basicUnsafeNew: negative length: " ++ show n + | n > mx = error $ "Storable.basicUnsafeNew: length too large: " ++ show n + | otherwise = unsafePrimToPrim $ do + fp <- mallocVector n + return $ MVector n fp + where + size = sizeOf (undefined :: a) + mx = maxBound `quot` size :: Int + + {-# INLINE basicInitialize #-} + basicInitialize = storableZero + + {-# INLINE basicUnsafeRead #-} + basicUnsafeRead (MVector _ fp) i + = unsafePrimToPrim + $ withForeignPtr fp (`peekElemOff` i) + + {-# INLINE basicUnsafeWrite #-} + basicUnsafeWrite (MVector _ fp) i x + = unsafePrimToPrim + $ withForeignPtr fp $ \p -> pokeElemOff p i x + + {-# INLINE basicSet #-} + basicSet = storableSet + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MVector n fp) (MVector _ fq) + = unsafePrimToPrim + $ withForeignPtr fp $ \p -> + withForeignPtr fq $ \q -> + copyArray p q n + + {-# INLINE basicUnsafeMove #-} + basicUnsafeMove (MVector n fp) (MVector _ fq) + = unsafePrimToPrim + $ withForeignPtr fp $ \p -> + withForeignPtr fq $ \q -> + moveArray p q n + +storableZero :: forall a m. (Storable a, PrimMonad m) => MVector (PrimState m) a -> m () +{-# INLINE storableZero #-} +storableZero (MVector n fp) = unsafePrimToPrim . withForeignPtr fp $ \(Ptr p) -> do + let q = Addr p + setAddr q byteSize (0 :: Word8) + where + x :: a + x = undefined + + byteSize :: Int + byteSize = n * sizeOf x + +storableSet :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> a -> m () +{-# INLINE storableSet #-} +storableSet (MVector n fp) x + | n == 0 = return () + | otherwise = unsafePrimToPrim $ + case sizeOf x of + 1 -> storableSetAsPrim n fp x (undefined :: Word8) + 2 -> storableSetAsPrim n fp x (undefined :: Word16) + 4 -> storableSetAsPrim n fp x (undefined :: Word32) + 8 -> storableSetAsPrim n fp x (undefined :: Word64) + _ -> withForeignPtr fp $ \p -> do + poke p x + + let do_set i + | 2*i < n = do + copyArray (p `advancePtr` i) p i + do_set (2*i) + | otherwise = copyArray (p `advancePtr` i) p (n-i) + + do_set 1 + +storableSetAsPrim + :: (Storable a, Prim b) => Int -> ForeignPtr a -> a -> b -> IO () +{-# INLINE [0] storableSetAsPrim #-} +storableSetAsPrim n fp x y = withForeignPtr fp $ \(Ptr p) -> do + poke (Ptr p) x + let q = Addr p + w <- readOffAddr q 0 + setAddr (q `plusAddr` sizeOf x) (n-1) (w `asTypeOf` y) + +{-# INLINE mallocVector #-} +mallocVector :: Storable a => Int -> IO (ForeignPtr a) +mallocVector = +#if __GLASGOW_HASKELL__ >= 706 + doMalloc undefined + where + doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b) + doMalloc dummy size = + mallocPlainForeignPtrAlignedBytes (size * sizeOf dummy) (alignment dummy) +#elif __GLASGOW_HASKELL__ >= 700 + doMalloc undefined + where + doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b) + doMalloc dummy size = do + arr@(MutableByteArray arr#) <- newAlignedPinnedByteArray arrSize arrAlign + newConcForeignPtr + (Ptr (byteArrayContents# (unsafeCoerce# arr#))) + -- Keep reference to mutable byte array until whole ForeignPtr goes out + -- of scope. + (touch arr) + where + arrSize = size * sizeOf dummy + arrAlign = alignment dummy +#else + mallocForeignPtrArray +#endif + +-- Length information +-- ------------------ + +-- | Length of the mutable vector. +length :: Storable a => MVector s a -> Int +{-# INLINE length #-} +length = G.length + +-- | Check whether the vector is empty +null :: Storable a => MVector s a -> Bool +{-# INLINE null #-} +null = G.null + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. +slice :: Storable a => Int -> Int -> MVector s a -> MVector s a +{-# INLINE slice #-} +slice = G.slice + +take :: Storable a => Int -> MVector s a -> MVector s a +{-# INLINE take #-} +take = G.take + +drop :: Storable a => Int -> MVector s a -> MVector s a +{-# INLINE drop #-} +drop = G.drop + +splitAt :: Storable a => Int -> MVector s a -> (MVector s a, MVector s a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +init :: Storable a => MVector s a -> MVector s a +{-# INLINE init #-} +init = G.init + +tail :: Storable a => MVector s a -> MVector s a +{-# INLINE tail #-} +tail = G.tail + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +unsafeSlice :: Storable a + => Int -- ^ starting index + -> Int -- ^ length of the slice + -> MVector s a + -> MVector s a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +unsafeTake :: Storable a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +unsafeDrop :: Storable a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +unsafeInit :: Storable a => MVector s a -> MVector s a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +unsafeTail :: Storable a => MVector s a -> MVector s a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +overlaps :: Storable a => MVector s a -> MVector s a -> Bool +{-# INLINE overlaps #-} +overlaps = G.overlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +new :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a) +{-# INLINE new #-} +new = G.new + +-- | Create a mutable vector of the given length. The memory is not initialized. +unsafeNew :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew = G.unsafeNew + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +replicate :: (PrimMonad m, Storable a) => Int -> a -> m (MVector (PrimState m) a) +{-# INLINE replicate #-} +replicate = G.replicate + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +replicateM :: (PrimMonad m, Storable a) => Int -> m a -> m (MVector (PrimState m) a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | Create a copy of a mutable vector. +clone :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -> m (MVector (PrimState m) a) +{-# INLINE clone #-} +clone = G.clone + +-- Growing +-- ------- + +-- | Grow a vector by the given number of elements. The number must be +-- positive. +grow :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE grow #-} +grow = G.grow + +-- | Grow a vector by the given number of elements. The number must be +-- positive but this is not checked. +unsafeGrow :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow = G.unsafeGrow + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- references to external objects. This is usually a noop for unboxed vectors. +clear :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> m () +{-# INLINE clear #-} +clear = G.clear + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. +read :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read = G.read + +-- | Replace the element at the given position. +write + :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE write #-} +write = G.write + +-- | Modify the element at the given position. +modify :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE modify #-} +modify = G.modify + +-- | Swap the elements at the given positions. +swap + :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap = G.swap + + +-- | Yield the element at the given position. No bounds checks are performed. +unsafeRead :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +unsafeRead = G.unsafeRead + +-- | Replace the element at the given position. No bounds checks are performed. +unsafeWrite + :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE unsafeWrite #-} +unsafeWrite = G.unsafeWrite + +-- | Modify the element at the given position. No bounds checks are performed. +unsafeModify :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE unsafeModify #-} +unsafeModify = G.unsafeModify + +-- | Swap the elements at the given positions. No bounds checks are performed. +unsafeSwap + :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE unsafeSwap #-} +unsafeSwap = G.unsafeSwap + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +set :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> a -> m () +{-# INLINE set #-} +set = G.set + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +copy :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE copy #-} +copy = G.copy + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. This is not checked. +unsafeCopy :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | Move the contents of a vector. The two vectors must have the same +-- length. +-- +-- If the vectors do not overlap, then this is equivalent to 'copy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +move :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -> MVector (PrimState m) a -> m () +{-# INLINE move #-} +move = G.move + +-- | Move the contents of a vector. The two vectors must have the same +-- length, but this is not checked. +-- +-- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +unsafeMove :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove = G.unsafeMove + +-- Unsafe conversions +-- ------------------ + +-- | /O(1)/ Unsafely cast a mutable vector from one element type to another. +-- The operation just changes the type of the underlying pointer and does not +-- modify the elements. +-- +-- The resulting vector contains as many elements as can fit into the +-- underlying memory block. +-- +unsafeCast :: forall a b s. + (Storable a, Storable b) => MVector s a -> MVector s b +{-# INLINE unsafeCast #-} +unsafeCast (MVector n fp) + = MVector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) + (castForeignPtr fp) + +-- Raw pointers +-- ------------ + +-- | Create a mutable vector from a 'ForeignPtr' with an offset and a length. +-- +-- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector +-- could have been frozen before the modification. +-- +-- If your offset is 0 it is more efficient to use 'unsafeFromForeignPtr0'. +unsafeFromForeignPtr :: Storable a + => ForeignPtr a -- ^ pointer + -> Int -- ^ offset + -> Int -- ^ length + -> MVector s a +{-# INLINE_FUSED unsafeFromForeignPtr #-} +unsafeFromForeignPtr fp i n = unsafeFromForeignPtr0 fp' n + where + fp' = updPtr (`advancePtr` i) fp + +{-# RULES +"unsafeFromForeignPtr fp 0 n -> unsafeFromForeignPtr0 fp n " forall fp n. + unsafeFromForeignPtr fp 0 n = unsafeFromForeignPtr0 fp n #-} + + +-- | /O(1)/ Create a mutable vector from a 'ForeignPtr' and a length. +-- +-- It is assumed the pointer points directly to the data (no offset). +-- Use `unsafeFromForeignPtr` if you need to specify an offset. +-- +-- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector +-- could have been frozen before the modification. +unsafeFromForeignPtr0 :: Storable a + => ForeignPtr a -- ^ pointer + -> Int -- ^ length + -> MVector s a +{-# INLINE unsafeFromForeignPtr0 #-} +unsafeFromForeignPtr0 fp n = MVector n fp + +-- | Yield the underlying 'ForeignPtr' together with the offset to the data +-- and its length. Modifying the data through the 'ForeignPtr' is +-- unsafe if the vector could have frozen before the modification. +unsafeToForeignPtr :: Storable a => MVector s a -> (ForeignPtr a, Int, Int) +{-# INLINE unsafeToForeignPtr #-} +unsafeToForeignPtr (MVector n fp) = (fp, 0, n) + +-- | /O(1)/ Yield the underlying 'ForeignPtr' together with its length. +-- +-- You can assume the pointer points directly to the data (no offset). +-- +-- Modifying the data through the 'ForeignPtr' is unsafe if the vector could +-- have frozen before the modification. +unsafeToForeignPtr0 :: Storable a => MVector s a -> (ForeignPtr a, Int) +{-# INLINE unsafeToForeignPtr0 #-} +unsafeToForeignPtr0 (MVector n fp) = (fp, n) + +-- | Pass a pointer to the vector's data to the IO action. Modifying data +-- through the pointer is unsafe if the vector could have been frozen before +-- the modification. +unsafeWith :: Storable a => IOVector a -> (Ptr a -> IO b) -> IO b +{-# INLINE unsafeWith #-} +unsafeWith (MVector _ fp) = withForeignPtr fp + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed.hs new file mode 100644 index 0000000000..72dd109fb3 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed.hs @@ -0,0 +1,1488 @@ +{-# LANGUAGE CPP, Rank2Types, TypeFamilies #-} + +-- | +-- Module : Data.Vector.Unboxed +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Adaptive unboxed vectors. The implementation is based on type families +-- and picks an efficient, specialised representation for every element type. +-- In particular, unboxed vectors of pairs are represented as pairs of unboxed +-- vectors. +-- +-- Implementing unboxed vectors for new data types can be very easy. Here is +-- how the library does this for 'Complex' by simply wrapping vectors of +-- pairs. +-- +-- @ +-- newtype instance 'MVector' s ('Complex' a) = MV_Complex ('MVector' s (a,a)) +-- newtype instance 'Vector' ('Complex' a) = V_Complex ('Vector' (a,a)) +-- +-- instance ('RealFloat' a, 'Unbox' a) => 'Data.Vector.Generic.Mutable.MVector' 'MVector' ('Complex' a) where +-- {-\# INLINE basicLength \#-} +-- basicLength (MV_Complex v) = 'Data.Vector.Generic.Mutable.basicLength' v +-- ... +-- +-- instance ('RealFloat' a, 'Unbox' a) => Data.Vector.Generic.Vector 'Vector' ('Complex' a) where +-- {-\# INLINE basicLength \#-} +-- basicLength (V_Complex v) = Data.Vector.Generic.basicLength v +-- ... +-- +-- instance ('RealFloat' a, 'Unbox' a) => 'Unbox' ('Complex' a) +-- @ + +module Data.Vector.Unboxed ( + -- * Unboxed vectors + Vector, MVector(..), Unbox, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + unsafeIndex, unsafeHead, unsafeLast, + + -- ** Monadic indexing + indexM, headM, lastM, + unsafeIndexM, unsafeHeadM, unsafeLastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, iterateNM, create, createT, + + -- ** Unfolding + unfoldr, unfoldrN, + unfoldrM, unfoldrNM, + constructN, constructrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update, update_, + unsafeUpd, unsafeUpdate, unsafeUpdate_, + + -- ** Accumulations + accum, accumulate, accumulate_, + unsafeAccum, unsafeAccumulate, unsafeAccumulate_, + + -- ** Permutations + reverse, backpermute, unsafeBackpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Indexing + indexed, + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, imapM, mapM_, imapM_, forM, forM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + zip, zip3, zip4, zip5, zip6, + + -- ** Monadic zipping + zipWithM, izipWithM, zipWithM_, izipWithM_, + + -- ** Unzipping + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, uniq, + mapMaybe, imapMaybe, + filterM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, span, break, + + -- ** Searching + elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + + -- ** Specialised folds + all, any, and, or, + sum, product, + maximum, maximumBy, minimum, minimumBy, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, ifoldM, foldM', ifoldM', + fold1M, fold1M', foldM_, ifoldM_, + foldM'_, ifoldM'_, fold1M_, fold1M'_, + + -- * Prefix sums (scans) + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Other vector types + G.convert, + + -- ** Mutable vectors + freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy +) where + +import Data.Vector.Unboxed.Base +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Fusion.Bundle as Bundle +import Data.Vector.Fusion.Util ( delayed_min ) + +import Control.Monad.ST ( ST ) +import Control.Monad.Primitive + +import Prelude hiding ( length, null, + replicate, (++), concat, + head, last, + init, tail, take, drop, splitAt, reverse, + map, concatMap, + zipWith, zipWith3, zip, zip3, unzip, unzip3, + filter, takeWhile, dropWhile, span, break, + elem, notElem, + foldl, foldl1, foldr, foldr1, + all, any, and, or, sum, product, minimum, maximum, + scanl, scanl1, scanr, scanr1, + enumFromTo, enumFromThenTo, + mapM, mapM_ ) + +import Text.Read ( Read(..), readListPrecDefault ) +import Data.Semigroup ( Semigroup(..) ) + +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid ( Monoid(..) ) +import Data.Traversable ( Traversable ) +#endif + +#if __GLASGOW_HASKELL__ >= 708 +import qualified GHC.Exts as Exts (IsList(..)) +#endif + +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- See http://trac.haskell.org/vector/ticket/12 +instance (Unbox a, Eq a) => Eq (Vector a) where + {-# INLINE (==) #-} + xs == ys = Bundle.eq (G.stream xs) (G.stream ys) + + {-# INLINE (/=) #-} + xs /= ys = not (Bundle.eq (G.stream xs) (G.stream ys)) + +-- See http://trac.haskell.org/vector/ticket/12 +instance (Unbox 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 Unbox a => Semigroup (Vector a) where + {-# INLINE (<>) #-} + (<>) = (++) + + {-# INLINE sconcat #-} + sconcat = G.concatNE + +instance Unbox a => Monoid (Vector a) where + {-# INLINE mempty #-} + mempty = empty + + {-# INLINE mappend #-} + mappend = (++) + + {-# INLINE mconcat #-} + mconcat = concat + +instance (Show a, Unbox a) => Show (Vector a) where + showsPrec = G.showsPrec + +instance (Read a, Unbox a) => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + +#if __GLASGOW_HASKELL__ >= 708 + +instance (Unbox e) => Exts.IsList (Vector e) where + type Item (Vector e) = e + fromList = fromList + fromListN = fromListN + toList = toList + +#endif + +-- Length information +-- ------------------ + +-- | /O(1)/ Yield the length of the vector +length :: Unbox a => Vector a -> Int +{-# INLINE length #-} +length = G.length + +-- | /O(1)/ Test whether a vector is empty +null :: Unbox a => Vector a -> Bool +{-# INLINE null #-} +null = G.null + +-- Indexing +-- -------- + +-- | O(1) Indexing +(!) :: Unbox a => Vector a -> Int -> a +{-# INLINE (!) #-} +(!) = (G.!) + +-- | O(1) Safe indexing +(!?) :: Unbox a => Vector a -> Int -> Maybe a +{-# INLINE (!?) #-} +(!?) = (G.!?) + +-- | /O(1)/ First element +head :: Unbox a => Vector a -> a +{-# INLINE head #-} +head = G.head + +-- | /O(1)/ Last element +last :: Unbox a => Vector a -> a +{-# INLINE last #-} +last = G.last + +-- | /O(1)/ Unsafe indexing without bounds checking +unsafeIndex :: Unbox a => Vector a -> Int -> a +{-# INLINE unsafeIndex #-} +unsafeIndex = G.unsafeIndex + +-- | /O(1)/ First element without checking if the vector is empty +unsafeHead :: Unbox a => Vector a -> a +{-# INLINE unsafeHead #-} +unsafeHead = G.unsafeHead + +-- | /O(1)/ Last element without checking if the vector is empty +unsafeLast :: Unbox a => Vector a -> a +{-# INLINE unsafeLast #-} +unsafeLast = G.unsafeLast + +-- Monadic indexing +-- ---------------- + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the vector when necessary. +-- Suppose vector copying is implemented like this: +-- +-- > copy mv v = ... write mv i (v ! i) ... +-- +-- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ +-- would unnecessarily retain a reference to @v@ in each element written. +-- +-- With 'indexM', copying can be implemented like this instead: +-- +-- > copy mv v = ... do +-- > x <- indexM v i +-- > write mv i x +-- +-- Here, no references to @v@ are retained because indexing (but /not/ the +-- elements) is evaluated eagerly. +-- +indexM :: (Unbox a, Monad m) => Vector a -> Int -> m a +{-# INLINE indexM #-} +indexM = G.indexM + +-- | /O(1)/ First element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +headM :: (Unbox a, Monad m) => Vector a -> m a +{-# INLINE headM #-} +headM = G.headM + +-- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +lastM :: (Unbox a, Monad m) => Vector a -> m a +{-# INLINE lastM #-} +lastM = G.lastM + +-- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an +-- explanation of why this is useful. +unsafeIndexM :: (Unbox a, Monad m) => Vector a -> Int -> m a +{-# INLINE unsafeIndexM #-} +unsafeIndexM = G.unsafeIndexM + +-- | /O(1)/ First element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeHeadM :: (Unbox a, Monad m) => Vector a -> m a +{-# INLINE unsafeHeadM #-} +unsafeHeadM = G.unsafeHeadM + +-- | /O(1)/ Last element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeLastM :: (Unbox a, Monad m) => Vector a -> m a +{-# INLINE unsafeLastM #-} +unsafeLastM = G.unsafeLastM + +-- Extracting subvectors (slicing) +-- ------------------------------- + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Unbox a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE slice #-} +slice = G.slice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty. +init :: Unbox a => Vector a -> Vector a +{-# INLINE init #-} +init = G.init + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty. +tail :: Unbox a => Vector a -> Vector a +{-# INLINE tail #-} +tail = G.tail + +-- | /O(1)/ Yield at the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case it is returned unchanged. +take :: Unbox a => Int -> Vector a -> Vector a +{-# INLINE take #-} +take = G.take + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case an empty vector is returned. +drop :: Unbox a => Int -> Vector a -> Vector a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ +-- but slightly more efficient. +{-# INLINE splitAt #-} +splitAt :: Unbox a => Int -> Vector a -> (Vector a, Vector a) +splitAt = G.splitAt + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must +-- contain at least @i+n@ elements but this is not checked. +unsafeSlice :: Unbox a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty but this is not checked. +unsafeInit :: Unbox a => Vector a -> Vector a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty but this is not checked. +unsafeTail :: Unbox a => Vector a -> Vector a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector must +-- contain at least @n@ elements but this is not checked. +unsafeTake :: Unbox a => Int -> Vector a -> Vector a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector +-- must contain at least @n@ elements but this is not checked. +unsafeDrop :: Unbox a => Int -> Vector a -> Vector a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- Initialisation +-- -------------- + +-- | /O(1)/ Empty vector +empty :: Unbox a => Vector a +{-# INLINE empty #-} +empty = G.empty + +-- | /O(1)/ Vector with exactly one element +singleton :: Unbox a => a -> Vector a +{-# INLINE singleton #-} +singleton = G.singleton + +-- | /O(n)/ Vector of the given length with the same value in each position +replicate :: Unbox a => Int -> a -> Vector a +{-# INLINE replicate #-} +replicate = G.replicate + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index +generate :: Unbox a => Int -> (Int -> a) -> Vector a +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Apply function n times to value. Zeroth element is original value. +iterateN :: Unbox a => Int -> (a -> a) -> a -> Vector a +{-# INLINE iterateN #-} +iterateN = G.iterateN + +-- Unfolding +-- --------- + +-- | /O(n)/ Construct a vector by repeatedly applying the generator function +-- to a seed. The generator function yields 'Just' the next element and the +-- new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 +-- > = <10,9,8,7,6,5,4,3,2,1> +unfoldr :: Unbox a => (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldr #-} +unfoldr = G.unfoldr + +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> +unfoldrN :: Unbox a => Int -> (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldrN #-} +unfoldrN = G.unfoldrN + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Unbox a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Unbox a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in f <a,b,c> +-- +constructN :: Unbox a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in f <c,b,a> +-- +constructrN :: Unbox a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN + +-- Enumeration +-- ----------- + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ +-- etc. This operation is usually more efficient than 'enumFromTo'. +-- +-- > enumFromN 5 3 = <5,6,7> +enumFromN :: (Unbox a, Num a) => a -> Int -> Vector a +{-# INLINE enumFromN #-} +enumFromN = G.enumFromN + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, +-- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. +-- +-- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> +enumFromStepN :: (Unbox a, Num a) => a -> a -> Int -> Vector a +{-# INLINE enumFromStepN #-} +enumFromStepN = G.enumFromStepN + +-- | /O(n)/ Enumerate values from @x@ to @y@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromN' instead. +enumFromTo :: (Unbox a, Enum a) => a -> a -> Vector a +{-# INLINE enumFromTo #-} +enumFromTo = G.enumFromTo + +-- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Unbox a, Enum a) => a -> a -> a -> Vector a +{-# INLINE enumFromThenTo #-} +enumFromThenTo = G.enumFromThenTo + +-- Concatenation +-- ------------- + +-- | /O(n)/ Prepend an element +cons :: Unbox a => a -> Vector a -> Vector a +{-# INLINE cons #-} +cons = G.cons + +-- | /O(n)/ Append an element +snoc :: Unbox a => Vector a -> a -> Vector a +{-# INLINE snoc #-} +snoc = G.snoc + +infixr 5 ++ +-- | /O(m+n)/ Concatenate two vectors +(++) :: Unbox a => Vector a -> Vector a -> Vector a +{-# INLINE (++) #-} +(++) = (G.++) + +-- | /O(n)/ Concatenate all vectors in the list +concat :: Unbox a => [Vector a] -> Vector a +{-# INLINE concat #-} +concat = G.concat + +-- Monadic initialisation +-- ---------------------- + +-- | /O(n)/ Execute the monadic action the given number of times and store the +-- results in a vector. +replicateM :: (Monad m, Unbox a) => Int -> m a -> m (Vector a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +generateM :: (Monad m, Unbox a) => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: (Monad m, Unbox a) => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + +-- | Execute the monadic action and freeze the resulting vector. +-- +-- @ +-- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> +-- @ +create :: Unbox a => (forall s. ST s (MVector s a)) -> Vector a +{-# INLINE create #-} +-- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 +create p = G.create p + +-- | Execute the monadic action and freeze the resulting vectors. +createT :: (Traversable f, Unbox a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + +-- Restricting memory usage +-- ------------------------ + +-- | /O(n)/ Yield the argument but force it not to retain any extra memory, +-- possibly by copying it. +-- +-- This is especially useful when dealing with slices. For example: +-- +-- > force (slice 0 2 <huge vector>) +-- +-- Here, the slice retains a reference to the huge vector. Forcing it creates +-- a copy of just the elements that belong to the slice and allows the huge +-- vector to be garbage collected. +force :: Unbox a => Vector a -> Vector a +{-# INLINE force #-} +force = G.force + +-- Bulk updates +-- ------------ + +-- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector +-- element at position @i@ by @a@. +-- +-- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> +-- +(//) :: Unbox a => Vector a -- ^ initial vector (of length @m@) + -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE (//) #-} +(//) = (G.//) + +-- | /O(m+n)/ For each pair @(i,a)@ from the vector of index/value pairs, +-- replace the vector element at position @i@ by @a@. +-- +-- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7> +-- +update :: Unbox a + => Vector a -- ^ initial vector (of length @m@) + -> Vector (Int, a) -- ^ vector of index/value pairs (of length @n@) + -> Vector a +{-# INLINE update #-} +update = G.update + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @a@ from the value vector, replace the element of the +-- initial vector at position @i@ by @a@. +-- +-- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> +-- +-- The function 'update' provides the same functionality and is usually more +-- convenient. +-- +-- @ +-- update_ xs is ys = 'update' xs ('zip' is ys) +-- @ +update_ :: Unbox a + => Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector a -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE update_ #-} +update_ = G.update_ + +-- | Same as ('//') but without bounds checking. +unsafeUpd :: Unbox a => Vector a -> [(Int, a)] -> Vector a +{-# INLINE unsafeUpd #-} +unsafeUpd = G.unsafeUpd + +-- | Same as 'update' but without bounds checking. +unsafeUpdate :: Unbox a => Vector a -> Vector (Int, a) -> Vector a +{-# INLINE unsafeUpdate #-} +unsafeUpdate = G.unsafeUpdate + +-- | Same as 'update_' but without bounds checking. +unsafeUpdate_ :: Unbox a => Vector a -> Vector Int -> Vector a -> Vector a +{-# INLINE unsafeUpdate_ #-} +unsafeUpdate_ = G.unsafeUpdate_ + +-- Accumulations +-- ------------- + +-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element +-- @a@ at position @i@ by @f a b@. +-- +-- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> +accum :: Unbox a + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accum #-} +accum = G.accum + +-- | /O(m+n)/ For each pair @(i,b)@ from the vector of pairs, replace the vector +-- element @a@ at position @i@ by @f a b@. +-- +-- > accumulate (+) <5,9,2> <(2,4),(1,6),(0,3),(1,7)> = <5+3, 9+6+7, 2+4> +accumulate :: (Unbox a, Unbox b) + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector (Int,b) -- ^ vector of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accumulate #-} +accumulate = G.accumulate + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the the value vector, +-- replace the element of the initial vector at +-- position @i@ by @f a b@. +-- +-- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> +-- +-- The function 'accumulate' provides the same functionality and is usually more +-- convenient. +-- +-- @ +-- accumulate_ f as is bs = 'accumulate' f as ('zip' is bs) +-- @ +accumulate_ :: (Unbox a, Unbox b) + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector b -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE accumulate_ #-} +accumulate_ = G.accumulate_ + +-- | Same as 'accum' but without bounds checking. +unsafeAccum :: Unbox a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a +{-# INLINE unsafeAccum #-} +unsafeAccum = G.unsafeAccum + +-- | Same as 'accumulate' but without bounds checking. +unsafeAccumulate :: (Unbox a, Unbox b) + => (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a +{-# INLINE unsafeAccumulate #-} +unsafeAccumulate = G.unsafeAccumulate + +-- | Same as 'accumulate_' but without bounds checking. +unsafeAccumulate_ :: (Unbox a, Unbox b) => + (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a +{-# INLINE unsafeAccumulate_ #-} +unsafeAccumulate_ = G.unsafeAccumulate_ + +-- Permutations +-- ------------ + +-- | /O(n)/ Reverse a vector +reverse :: Unbox a => Vector a -> Vector a +{-# INLINE reverse #-} +reverse = G.reverse + +-- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the +-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is +-- often much more efficient. +-- +-- > backpermute <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a> +backpermute :: Unbox a => Vector a -> Vector Int -> Vector a +{-# INLINE backpermute #-} +backpermute = G.backpermute + +-- | Same as 'backpermute' but without bounds checking. +unsafeBackpermute :: Unbox a => Vector a -> Vector Int -> Vector a +{-# INLINE unsafeBackpermute #-} +unsafeBackpermute = G.unsafeBackpermute + +-- Safe destructive updates +-- ------------------------ + +-- | Apply a destructive operation to a vector. The operation will be +-- performed in place if it is safe to do so and will modify a copy of the +-- vector otherwise. +-- +-- @ +-- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> +-- @ +modify :: Unbox a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a +{-# INLINE modify #-} +modify p = G.modify p + +-- Indexing +-- -------- + +-- | /O(n)/ Pair each element in a vector with its index +indexed :: Unbox a => Vector a -> Vector (Int,a) +{-# INLINE indexed #-} +indexed = G.indexed + +-- Mapping +-- ------- + +-- | /O(n)/ Map a function over a vector +map :: (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b +{-# INLINE map #-} +map = G.map + +-- | /O(n)/ Apply a function to every element of a vector and its index +imap :: (Unbox a, Unbox b) => (Int -> a -> b) -> Vector a -> Vector b +{-# INLINE imap #-} +imap = G.imap + +-- | Map a function over a vector and concatenate the results. +concatMap :: (Unbox a, Unbox b) => (a -> Vector b) -> Vector a -> Vector b +{-# INLINE concatMap #-} +concatMap = G.concatMap + +-- Monadic mapping +-- --------------- + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results +mapM :: (Monad m, Unbox a, Unbox b) => (a -> m b) -> Vector a -> m (Vector b) +{-# INLINE mapM #-} +mapM = G.mapM + +-- | /O(n)/ Apply the monadic action to every element of a vector and its +-- index, yielding a vector of results +imapM :: (Monad m, Unbox a, Unbox b) + => (Int -> a -> m b) -> Vector a -> m (Vector b) +{-# INLINE imapM #-} +imapM = G.imapM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results +mapM_ :: (Monad m, Unbox a) => (a -> m b) -> Vector a -> m () +{-# INLINE mapM_ #-} +mapM_ = G.mapM_ + +-- | /O(n)/ Apply the monadic action to every element of a vector and its +-- index, ignoring the results +imapM_ :: (Monad m, Unbox a) => (Int -> a -> m b) -> Vector a -> m () +{-# INLINE imapM_ #-} +imapM_ = G.imapM_ + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results. Equivalent to @flip 'mapM'@. +forM :: (Monad m, Unbox a, Unbox b) => Vector a -> (a -> m b) -> m (Vector b) +{-# INLINE forM #-} +forM = G.forM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results. Equivalent to @flip 'mapM_'@. +forM_ :: (Monad m, Unbox a) => Vector a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- Zipping +-- ------- + +-- | /O(min(m,n))/ Zip two vectors with the given function. +zipWith :: (Unbox a, Unbox b, Unbox c) + => (a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE zipWith #-} +zipWith = G.zipWith + +-- | Zip three vectors with the given function. +zipWith3 :: (Unbox a, Unbox b, Unbox c, Unbox d) + => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE zipWith3 #-} +zipWith3 = G.zipWith3 + +zipWith4 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) + => (a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE zipWith4 #-} +zipWith4 = G.zipWith4 + +zipWith5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) + => (a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE zipWith5 #-} +zipWith5 = G.zipWith5 + +zipWith6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f, Unbox g) + => (a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE zipWith6 #-} +zipWith6 = G.zipWith6 + +-- | /O(min(m,n))/ Zip two vectors with a function that also takes the +-- elements' indices. +izipWith :: (Unbox a, Unbox b, Unbox c) + => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE izipWith #-} +izipWith = G.izipWith + +-- | Zip three vectors and their indices with the given function. +izipWith3 :: (Unbox a, Unbox b, Unbox c, Unbox d) + => (Int -> a -> b -> c -> d) + -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE izipWith3 #-} +izipWith3 = G.izipWith3 + +izipWith4 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) + => (Int -> a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE izipWith4 #-} +izipWith4 = G.izipWith4 + +izipWith5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) + => (Int -> a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE izipWith5 #-} +izipWith5 = G.izipWith5 + +izipWith6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f, Unbox g) + => (Int -> a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE izipWith6 #-} +izipWith6 = G.izipWith6 + +-- Monadic zipping +-- --------------- + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a +-- vector of results +zipWithM :: (Monad m, Unbox a, Unbox b, Unbox c) + => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +{-# INLINE zipWithM #-} +zipWithM = G.zipWithM + +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes +-- the element index and yield a vector of results +izipWithM :: (Monad m, Unbox a, Unbox b, Unbox c) + => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +{-# INLINE izipWithM #-} +izipWithM = G.izipWithM + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the +-- results +zipWithM_ :: (Monad m, Unbox a, Unbox b) + => (a -> b -> m c) -> Vector a -> Vector b -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ = G.zipWithM_ + +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes +-- the element index and ignore the results +izipWithM_ :: (Monad m, Unbox a, Unbox b) + => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m () +{-# INLINE izipWithM_ #-} +izipWithM_ = G.izipWithM_ + +-- Filtering +-- --------- + +-- | /O(n)/ Drop elements that do not satisfy the predicate +filter :: Unbox a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE filter #-} +filter = G.filter + +-- | /O(n)/ Drop repeated adjacent elements. +uniq :: (Unbox a, Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + +-- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to +-- values and their indices +ifilter :: Unbox a => (Int -> a -> Bool) -> Vector a -> Vector a +{-# INLINE ifilter #-} +ifilter = G.ifilter + +-- | /O(n)/ Drop elements when predicate returns Nothing +mapMaybe :: (Unbox a, Unbox b) => (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing +imapMaybe :: (Unbox a, Unbox b) => (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + +-- | /O(n)/ Drop elements that do not satisfy the monadic predicate +filterM :: (Monad m, Unbox a) => (a -> m Bool) -> Vector a -> m (Vector a) +{-# INLINE filterM #-} +filterM = G.filterM + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate +-- without copying. +takeWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE takeWhile #-} +takeWhile = G.takeWhile + +-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate +-- without copying. +dropWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE dropWhile #-} +dropWhile = G.dropWhile + +-- Parititioning +-- ------------- + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. The +-- relative order of the elements is preserved at the cost of a sometimes +-- reduced performance compared to 'unstablePartition'. +partition :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE partition #-} +partition = G.partition + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. +-- The order of the elements is not preserved but the operation is often +-- faster than 'partition'. +unstablePartition :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE unstablePartition #-} +unstablePartition = G.unstablePartition + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +span :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE span #-} +span = G.span + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +break :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE break #-} +break = G.break + +-- Searching +-- --------- + +infix 4 `elem` +-- | /O(n)/ Check if the vector contains an element +elem :: (Unbox a, Eq a) => a -> Vector a -> Bool +{-# INLINE elem #-} +elem = G.elem + +infix 4 `notElem` +-- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') +notElem :: (Unbox a, Eq a) => a -> Vector a -> Bool +{-# INLINE notElem #-} +notElem = G.notElem + +-- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' +-- if no such element exists. +find :: Unbox a => (a -> Bool) -> Vector a -> Maybe a +{-# INLINE find #-} +find = G.find + +-- | /O(n)/ Yield 'Just' the index of the first element matching the predicate +-- or 'Nothing' if no such element exists. +findIndex :: Unbox a => (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndex #-} +findIndex = G.findIndex + +-- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending +-- order. +findIndices :: Unbox a => (a -> Bool) -> Vector a -> Vector Int +{-# INLINE findIndices #-} +findIndices = G.findIndices + +-- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or +-- 'Nothing' if the vector does not contain the element. This is a specialised +-- version of 'findIndex'. +elemIndex :: (Unbox a, Eq a) => a -> Vector a -> Maybe Int +{-# INLINE elemIndex #-} +elemIndex = G.elemIndex + +-- | /O(n)/ Yield the indices of all occurences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +elemIndices :: (Unbox a, Eq a) => a -> Vector a -> Vector Int +{-# INLINE elemIndices #-} +elemIndices = G.elemIndices + +-- Folding +-- ------- + +-- | /O(n)/ Left fold +foldl :: Unbox b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Left fold on non-empty vectors +foldl1 :: Unbox a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1 #-} +foldl1 = G.foldl1 + +-- | /O(n)/ Left fold with strict accumulator +foldl' :: Unbox b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Left fold on non-empty vectors with strict accumulator +foldl1' :: Unbox a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1' #-} +foldl1' = G.foldl1' + +-- | /O(n)/ Right fold +foldr :: Unbox a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Right fold on non-empty vectors +foldr1 :: Unbox a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1 #-} +foldr1 = G.foldr1 + +-- | /O(n)/ Right fold with a strict accumulator +foldr' :: Unbox a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Right fold on non-empty vectors with strict accumulator +foldr1' :: Unbox a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1' #-} +foldr1' = G.foldr1' + +-- | /O(n)/ Left fold (function applied to each element and its index) +ifoldl :: Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Left fold with strict accumulator (function applied to each element +-- and its index) +ifoldl' :: Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Right fold (function applied to each element and its index) +ifoldr :: Unbox a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Right fold with strict accumulator (function applied to each +-- element and its index) +ifoldr' :: Unbox a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- Specialised folds +-- ----------------- + +-- | /O(n)/ Check if all elements satisfy the predicate. +all :: Unbox a => (a -> Bool) -> Vector a -> Bool +{-# INLINE all #-} +all = G.all + +-- | /O(n)/ Check if any element satisfies the predicate. +any :: Unbox a => (a -> Bool) -> Vector a -> Bool +{-# INLINE any #-} +any = G.any + +-- | /O(n)/ Check if all elements are 'True' +and :: Vector Bool -> Bool +{-# INLINE and #-} +and = G.and + +-- | /O(n)/ Check if any element is 'True' +or :: Vector Bool -> Bool +{-# INLINE or #-} +or = G.or + +-- | /O(n)/ Compute the sum of the elements +sum :: (Unbox a, Num a) => Vector a -> a +{-# INLINE sum #-} +sum = G.sum + +-- | /O(n)/ Compute the produce of the elements +product :: (Unbox a, Num a) => Vector a -> a +{-# INLINE product #-} +product = G.product + +-- | /O(n)/ Yield the maximum element of the vector. The vector may not be +-- empty. +maximum :: (Unbox a, Ord a) => Vector a -> a +{-# INLINE maximum #-} +maximum = G.maximum + +-- | /O(n)/ Yield the maximum element of the vector according to the given +-- comparison function. The vector may not be empty. +maximumBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE maximumBy #-} +maximumBy = G.maximumBy + +-- | /O(n)/ Yield the minimum element of the vector. The vector may not be +-- empty. +minimum :: (Unbox a, Ord a) => Vector a -> a +{-# INLINE minimum #-} +minimum = G.minimum + +-- | /O(n)/ Yield the minimum element of the vector according to the given +-- comparison function. The vector may not be empty. +minimumBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE minimumBy #-} +minimumBy = G.minimumBy + +-- | /O(n)/ Yield the index of the maximum element of the vector. The vector +-- may not be empty. +maxIndex :: (Unbox a, Ord a) => Vector a -> Int +{-# INLINE maxIndex #-} +maxIndex = G.maxIndex + +-- | /O(n)/ Yield the index of the maximum element of the vector according to +-- the given comparison function. The vector may not be empty. +maxIndexBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE maxIndexBy #-} +maxIndexBy = G.maxIndexBy + +-- | /O(n)/ Yield the index of the minimum element of the vector. The vector +-- may not be empty. +minIndex :: (Unbox a, Ord a) => Vector a -> Int +{-# INLINE minIndex #-} +minIndex = G.minIndex + +-- | /O(n)/ Yield the index of the minimum element of the vector according to +-- the given comparison function. The vector may not be empty. +minIndexBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE minIndexBy #-} +minIndexBy = G.minIndexBy + +-- Monadic folds +-- ------------- + +-- | /O(n)/ Monadic fold +foldM :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold (action applied to each element and its index) +ifoldM :: (Monad m, Unbox b) => (a -> Int -> b -> m a) -> a -> Vector b -> m a +{-# INLINE ifoldM #-} +ifoldM = G.ifoldM + +-- | /O(n)/ Monadic fold over non-empty vectors +fold1M :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M #-} +fold1M = G.fold1M + +-- | /O(n)/ Monadic fold with strict accumulator +foldM' :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold with strict accumulator (action applied to each +-- element and its index) +ifoldM' :: (Monad m, Unbox b) => (a -> Int -> b -> m a) -> a -> Vector b -> m a +{-# INLINE ifoldM' #-} +ifoldM' = G.ifoldM' + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +fold1M' :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M' #-} +fold1M' = G.fold1M' + +-- | /O(n)/ Monadic fold that discards the result +foldM_ :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold that discards the result (action applied to each +-- element and its index) +ifoldM_ :: (Monad m, Unbox b) => (a -> Int -> b -> m a) -> a -> Vector b -> m () +{-# INLINE ifoldM_ #-} +ifoldM_ = G.ifoldM_ + +-- | /O(n)/ Monadic fold over non-empty vectors that discards the result +fold1M_ :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +foldM'_ :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +-- (action applied to each element and its index) +ifoldM'_ :: (Monad m, Unbox b) + => (a -> Int -> b -> m a) -> a -> Vector b -> m () +{-# INLINE ifoldM'_ #-} +ifoldM'_ = G.ifoldM'_ + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +-- that discards the result +fold1M'_ :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + +-- Prefix sums (scans) +-- ------------------- + +-- | /O(n)/ Prescan +-- +-- @ +-- prescanl f z = 'init' . 'scanl' f z +-- @ +-- +-- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ +-- +prescanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl #-} +prescanl = G.prescanl + +-- | /O(n)/ Prescan with strict accumulator +prescanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl' #-} +prescanl' = G.prescanl' + +-- | /O(n)/ Scan +-- +-- @ +-- postscanl f z = 'tail' . 'scanl' f z +-- @ +-- +-- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ +-- +postscanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl #-} +postscanl = G.postscanl + +-- | /O(n)/ Scan with strict accumulator +postscanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl' #-} +postscanl' = G.postscanl' + +-- | /O(n)/ Haskell-style scan +-- +-- > scanl f z <x1,...,xn> = <y1,...,y(n+1)> +-- > where y1 = z +-- > yi = f y(i-1) x(i-1) +-- +-- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@ +-- +scanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl #-} +scanl = G.scanl + +-- | /O(n)/ Haskell-style scan with strict accumulator +scanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl' #-} +scanl' = G.scanl' + +-- | /O(n)/ Scan over a non-empty vector +-- +-- > scanl f <x1,...,xn> = <y1,...,yn> +-- > where y1 = x1 +-- > yi = f y(i-1) xi +-- +scanl1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1 #-} +scanl1 = G.scanl1 + +-- | /O(n)/ Scan over a non-empty vector with a strict accumulator +scanl1' :: Unbox a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1' #-} +scanl1' = G.scanl1' + +-- | /O(n)/ Right-to-left prescan +-- +-- @ +-- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' +-- @ +-- +prescanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr #-} +prescanr = G.prescanr + +-- | /O(n)/ Right-to-left prescan with strict accumulator +prescanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr' #-} +prescanr' = G.prescanr' + +-- | /O(n)/ Right-to-left scan +postscanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr #-} +postscanr = G.postscanr + +-- | /O(n)/ Right-to-left scan with strict accumulator +postscanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr' #-} +postscanr' = G.postscanr' + +-- | /O(n)/ Right-to-left Haskell-style scan +scanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr #-} +scanr = G.scanr + +-- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator +scanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr' #-} +scanr' = G.scanr' + +-- | /O(n)/ Right-to-left scan over a non-empty vector +scanr1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1 #-} +scanr1 = G.scanr1 + +-- | /O(n)/ Right-to-left scan over a non-empty vector with a strict +-- accumulator +scanr1' :: Unbox a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1' #-} +scanr1' = G.scanr1' + +-- Conversions - Lists +-- ------------------------ + +-- | /O(n)/ Convert a vector to a list +toList :: Unbox a => Vector a -> [a] +{-# INLINE toList #-} +toList = G.toList + +-- | /O(n)/ Convert a list to a vector +fromList :: Unbox a => [a] -> Vector a +{-# INLINE fromList #-} +fromList = G.fromList + +-- | /O(n)/ Convert the first @n@ elements of a list to a vector +-- +-- @ +-- fromListN n xs = 'fromList' ('take' n xs) +-- @ +fromListN :: Unbox a => Int -> [a] -> Vector a +{-# INLINE fromListN #-} +fromListN = G.fromListN + +-- Conversions - Mutable vectors +-- ----------------------------- + +-- | /O(1)/ Unsafe convert a mutable vector to an immutable one without +-- copying. The mutable vector may not be used after this operation. +unsafeFreeze :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE unsafeFreeze #-} +unsafeFreeze = G.unsafeFreeze + +-- | /O(1)/ Unsafely convert an immutable vector to a mutable one without +-- copying. The immutable vector may not be used after this operation. +unsafeThaw :: (Unbox a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE unsafeThaw #-} +unsafeThaw = G.unsafeThaw + +-- | /O(n)/ Yield a mutable copy of the immutable vector. +thaw :: (Unbox a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE thaw #-} +thaw = G.thaw + +-- | /O(n)/ Yield an immutable copy of the mutable vector. +freeze :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE freeze #-} +freeze = G.freeze + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. This is not checked. +unsafeCopy + :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. +copy :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () +{-# INLINE copy #-} +copy = G.copy + + +#define DEFINE_IMMUTABLE +#include "unbox-tuple-instances" diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Base.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Base.hs new file mode 100644 index 0000000000..a88795c5b4 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Base.hs @@ -0,0 +1,408 @@ +{-# LANGUAGE BangPatterns, CPP, MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-} +#if __GLASGOW_HASKELL__ >= 707 +{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} +#endif +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Module : Data.Vector.Unboxed.Base +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Adaptive unboxed vectors: basic implementation +-- + +module Data.Vector.Unboxed.Base ( + MVector(..), IOVector, STVector, Vector(..), Unbox +) where + +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Generic.Mutable as M + +import qualified Data.Vector.Primitive as P + +import Control.DeepSeq ( NFData(rnf) ) + +import Control.Monad.Primitive +import Control.Monad ( liftM ) + +import Data.Word ( Word8, Word16, Word32, Word64 ) +import Data.Int ( Int8, Int16, Int32, Int64 ) +import Data.Complex + +#if !MIN_VERSION_base(4,8,0) +import Data.Word ( Word ) +#endif + +#if __GLASGOW_HASKELL__ >= 707 +import Data.Typeable ( Typeable ) +#else +import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp, + mkTyCon3 + ) +#endif + +import Data.Data ( Data(..) ) + +-- Data.Vector.Internal.Check is unused +#define NOT_VECTOR_MODULE +#include "vector.h" + +data family MVector s a +data family Vector a + +type IOVector = MVector RealWorld +type STVector s = MVector s + +type instance G.Mutable Vector = MVector + +class (G.Vector Vector a, M.MVector MVector a) => Unbox a + +instance NFData (Vector a) where rnf !_ = () +instance NFData (MVector s a) where rnf !_ = () + +-- ----------------- +-- Data and Typeable +-- ----------------- +#if __GLASGOW_HASKELL__ >= 707 +deriving instance Typeable Vector +deriving instance Typeable MVector +#else +vectorTyCon = mkTyCon3 "vector" + +instance Typeable1 Vector where + typeOf1 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") [] + +instance Typeable2 MVector where + typeOf2 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") [] +#endif + +instance (Data a, Unbox a) => Data (Vector a) where + gfoldl = G.gfoldl + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = G.mkType "Data.Vector.Unboxed.Vector" + dataCast1 = G.dataCast + +-- ---- +-- Unit +-- ---- + +newtype instance MVector s () = MV_Unit Int +newtype instance Vector () = V_Unit Int + +instance Unbox () + +instance M.MVector MVector () where + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicClear #-} + {-# INLINE basicSet #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeGrow #-} + + basicLength (MV_Unit n) = n + + basicUnsafeSlice _ m (MV_Unit _) = MV_Unit m + + basicOverlaps _ _ = False + + basicUnsafeNew n = return (MV_Unit n) + + -- Nothing to initialize + basicInitialize _ = return () + + basicUnsafeRead (MV_Unit _) _ = return () + + basicUnsafeWrite (MV_Unit _) _ () = return () + + basicClear _ = return () + + basicSet (MV_Unit _) () = return () + + basicUnsafeCopy (MV_Unit _) (MV_Unit _) = return () + + basicUnsafeGrow (MV_Unit n) m = return $ MV_Unit (n+m) + +instance G.Vector Vector () where + {-# INLINE basicUnsafeFreeze #-} + basicUnsafeFreeze (MV_Unit n) = return $ V_Unit n + + {-# INLINE basicUnsafeThaw #-} + basicUnsafeThaw (V_Unit n) = return $ MV_Unit n + + {-# INLINE basicLength #-} + basicLength (V_Unit n) = n + + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice _ m (V_Unit _) = V_Unit m + + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM (V_Unit _) _ = return () + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MV_Unit _) (V_Unit _) = return () + + {-# INLINE elemseq #-} + elemseq _ = seq + + +-- --------------- +-- Primitive types +-- --------------- + +#define primMVector(ty,con) \ +instance M.MVector MVector ty where { \ + {-# INLINE basicLength #-} \ +; {-# INLINE basicUnsafeSlice #-} \ +; {-# INLINE basicOverlaps #-} \ +; {-# INLINE basicUnsafeNew #-} \ +; {-# INLINE basicInitialize #-} \ +; {-# INLINE basicUnsafeReplicate #-} \ +; {-# INLINE basicUnsafeRead #-} \ +; {-# INLINE basicUnsafeWrite #-} \ +; {-# INLINE basicClear #-} \ +; {-# INLINE basicSet #-} \ +; {-# INLINE basicUnsafeCopy #-} \ +; {-# INLINE basicUnsafeGrow #-} \ +; basicLength (con v) = M.basicLength v \ +; basicUnsafeSlice i n (con v) = con $ M.basicUnsafeSlice i n v \ +; basicOverlaps (con v1) (con v2) = M.basicOverlaps v1 v2 \ +; basicUnsafeNew n = con `liftM` M.basicUnsafeNew n \ +; basicInitialize (con v) = M.basicInitialize v \ +; basicUnsafeReplicate n x = con `liftM` M.basicUnsafeReplicate n x \ +; basicUnsafeRead (con v) i = M.basicUnsafeRead v i \ +; basicUnsafeWrite (con v) i x = M.basicUnsafeWrite v i x \ +; basicClear (con v) = M.basicClear v \ +; basicSet (con v) x = M.basicSet v x \ +; basicUnsafeCopy (con v1) (con v2) = M.basicUnsafeCopy v1 v2 \ +; basicUnsafeMove (con v1) (con v2) = M.basicUnsafeMove v1 v2 \ +; basicUnsafeGrow (con v) n = con `liftM` M.basicUnsafeGrow v n } + +#define primVector(ty,con,mcon) \ +instance G.Vector Vector ty where { \ + {-# INLINE basicUnsafeFreeze #-} \ +; {-# INLINE basicUnsafeThaw #-} \ +; {-# INLINE basicLength #-} \ +; {-# INLINE basicUnsafeSlice #-} \ +; {-# INLINE basicUnsafeIndexM #-} \ +; {-# INLINE elemseq #-} \ +; basicUnsafeFreeze (mcon v) = con `liftM` G.basicUnsafeFreeze v \ +; basicUnsafeThaw (con v) = mcon `liftM` G.basicUnsafeThaw v \ +; basicLength (con v) = G.basicLength v \ +; basicUnsafeSlice i n (con v) = con $ G.basicUnsafeSlice i n v \ +; basicUnsafeIndexM (con v) i = G.basicUnsafeIndexM v i \ +; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v \ +; elemseq _ = seq } + +newtype instance MVector s Int = MV_Int (P.MVector s Int) +newtype instance Vector Int = V_Int (P.Vector Int) +instance Unbox Int +primMVector(Int, MV_Int) +primVector(Int, V_Int, MV_Int) + +newtype instance MVector s Int8 = MV_Int8 (P.MVector s Int8) +newtype instance Vector Int8 = V_Int8 (P.Vector Int8) +instance Unbox Int8 +primMVector(Int8, MV_Int8) +primVector(Int8, V_Int8, MV_Int8) + +newtype instance MVector s Int16 = MV_Int16 (P.MVector s Int16) +newtype instance Vector Int16 = V_Int16 (P.Vector Int16) +instance Unbox Int16 +primMVector(Int16, MV_Int16) +primVector(Int16, V_Int16, MV_Int16) + +newtype instance MVector s Int32 = MV_Int32 (P.MVector s Int32) +newtype instance Vector Int32 = V_Int32 (P.Vector Int32) +instance Unbox Int32 +primMVector(Int32, MV_Int32) +primVector(Int32, V_Int32, MV_Int32) + +newtype instance MVector s Int64 = MV_Int64 (P.MVector s Int64) +newtype instance Vector Int64 = V_Int64 (P.Vector Int64) +instance Unbox Int64 +primMVector(Int64, MV_Int64) +primVector(Int64, V_Int64, MV_Int64) + + +newtype instance MVector s Word = MV_Word (P.MVector s Word) +newtype instance Vector Word = V_Word (P.Vector Word) +instance Unbox Word +primMVector(Word, MV_Word) +primVector(Word, V_Word, MV_Word) + +newtype instance MVector s Word8 = MV_Word8 (P.MVector s Word8) +newtype instance Vector Word8 = V_Word8 (P.Vector Word8) +instance Unbox Word8 +primMVector(Word8, MV_Word8) +primVector(Word8, V_Word8, MV_Word8) + +newtype instance MVector s Word16 = MV_Word16 (P.MVector s Word16) +newtype instance Vector Word16 = V_Word16 (P.Vector Word16) +instance Unbox Word16 +primMVector(Word16, MV_Word16) +primVector(Word16, V_Word16, MV_Word16) + +newtype instance MVector s Word32 = MV_Word32 (P.MVector s Word32) +newtype instance Vector Word32 = V_Word32 (P.Vector Word32) +instance Unbox Word32 +primMVector(Word32, MV_Word32) +primVector(Word32, V_Word32, MV_Word32) + +newtype instance MVector s Word64 = MV_Word64 (P.MVector s Word64) +newtype instance Vector Word64 = V_Word64 (P.Vector Word64) +instance Unbox Word64 +primMVector(Word64, MV_Word64) +primVector(Word64, V_Word64, MV_Word64) + + +newtype instance MVector s Float = MV_Float (P.MVector s Float) +newtype instance Vector Float = V_Float (P.Vector Float) +instance Unbox Float +primMVector(Float, MV_Float) +primVector(Float, V_Float, MV_Float) + +newtype instance MVector s Double = MV_Double (P.MVector s Double) +newtype instance Vector Double = V_Double (P.Vector Double) +instance Unbox Double +primMVector(Double, MV_Double) +primVector(Double, V_Double, MV_Double) + + +newtype instance MVector s Char = MV_Char (P.MVector s Char) +newtype instance Vector Char = V_Char (P.Vector Char) +instance Unbox Char +primMVector(Char, MV_Char) +primVector(Char, V_Char, MV_Char) + +-- ---- +-- Bool +-- ---- + +fromBool :: Bool -> Word8 +{-# INLINE fromBool #-} +fromBool True = 1 +fromBool False = 0 + +toBool :: Word8 -> Bool +{-# INLINE toBool #-} +toBool 0 = False +toBool _ = True + +newtype instance MVector s Bool = MV_Bool (P.MVector s Word8) +newtype instance Vector Bool = V_Bool (P.Vector Word8) + +instance Unbox Bool + +instance M.MVector MVector Bool where + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicUnsafeReplicate #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicClear #-} + {-# INLINE basicSet #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeGrow #-} + basicLength (MV_Bool v) = M.basicLength v + basicUnsafeSlice i n (MV_Bool v) = MV_Bool $ M.basicUnsafeSlice i n v + basicOverlaps (MV_Bool v1) (MV_Bool v2) = M.basicOverlaps v1 v2 + basicUnsafeNew n = MV_Bool `liftM` M.basicUnsafeNew n + basicInitialize (MV_Bool v) = M.basicInitialize v + basicUnsafeReplicate n x = MV_Bool `liftM` M.basicUnsafeReplicate n (fromBool x) + basicUnsafeRead (MV_Bool v) i = toBool `liftM` M.basicUnsafeRead v i + basicUnsafeWrite (MV_Bool v) i x = M.basicUnsafeWrite v i (fromBool x) + basicClear (MV_Bool v) = M.basicClear v + basicSet (MV_Bool v) x = M.basicSet v (fromBool x) + basicUnsafeCopy (MV_Bool v1) (MV_Bool v2) = M.basicUnsafeCopy v1 v2 + basicUnsafeMove (MV_Bool v1) (MV_Bool v2) = M.basicUnsafeMove v1 v2 + basicUnsafeGrow (MV_Bool v) n = MV_Bool `liftM` M.basicUnsafeGrow v n + +instance G.Vector Vector Bool where + {-# INLINE basicUnsafeFreeze #-} + {-# INLINE basicUnsafeThaw #-} + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicUnsafeIndexM #-} + {-# INLINE elemseq #-} + basicUnsafeFreeze (MV_Bool v) = V_Bool `liftM` G.basicUnsafeFreeze v + basicUnsafeThaw (V_Bool v) = MV_Bool `liftM` G.basicUnsafeThaw v + basicLength (V_Bool v) = G.basicLength v + basicUnsafeSlice i n (V_Bool v) = V_Bool $ G.basicUnsafeSlice i n v + basicUnsafeIndexM (V_Bool v) i = toBool `liftM` G.basicUnsafeIndexM v i + basicUnsafeCopy (MV_Bool mv) (V_Bool v) = G.basicUnsafeCopy mv v + elemseq _ = seq + +-- ------- +-- Complex +-- ------- + +newtype instance MVector s (Complex a) = MV_Complex (MVector s (a,a)) +newtype instance Vector (Complex a) = V_Complex (Vector (a,a)) + +instance (Unbox a) => Unbox (Complex a) + +instance (Unbox a) => M.MVector MVector (Complex a) where + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicUnsafeReplicate #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicClear #-} + {-# INLINE basicSet #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeGrow #-} + basicLength (MV_Complex v) = M.basicLength v + basicUnsafeSlice i n (MV_Complex v) = MV_Complex $ M.basicUnsafeSlice i n v + basicOverlaps (MV_Complex v1) (MV_Complex v2) = M.basicOverlaps v1 v2 + basicUnsafeNew n = MV_Complex `liftM` M.basicUnsafeNew n + basicInitialize (MV_Complex v) = M.basicInitialize v + basicUnsafeReplicate n (x :+ y) = MV_Complex `liftM` M.basicUnsafeReplicate n (x,y) + basicUnsafeRead (MV_Complex v) i = uncurry (:+) `liftM` M.basicUnsafeRead v i + basicUnsafeWrite (MV_Complex v) i (x :+ y) = M.basicUnsafeWrite v i (x,y) + basicClear (MV_Complex v) = M.basicClear v + basicSet (MV_Complex v) (x :+ y) = M.basicSet v (x,y) + basicUnsafeCopy (MV_Complex v1) (MV_Complex v2) = M.basicUnsafeCopy v1 v2 + basicUnsafeMove (MV_Complex v1) (MV_Complex v2) = M.basicUnsafeMove v1 v2 + basicUnsafeGrow (MV_Complex v) n = MV_Complex `liftM` M.basicUnsafeGrow v n + +instance (Unbox a) => G.Vector Vector (Complex a) where + {-# INLINE basicUnsafeFreeze #-} + {-# INLINE basicUnsafeThaw #-} + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicUnsafeIndexM #-} + {-# INLINE elemseq #-} + basicUnsafeFreeze (MV_Complex v) = V_Complex `liftM` G.basicUnsafeFreeze v + basicUnsafeThaw (V_Complex v) = MV_Complex `liftM` G.basicUnsafeThaw v + basicLength (V_Complex v) = G.basicLength v + basicUnsafeSlice i n (V_Complex v) = V_Complex $ G.basicUnsafeSlice i n v + basicUnsafeIndexM (V_Complex v) i + = uncurry (:+) `liftM` G.basicUnsafeIndexM v i + basicUnsafeCopy (MV_Complex mv) (V_Complex v) + = G.basicUnsafeCopy mv v + elemseq _ (x :+ y) z = G.elemseq (undefined :: Vector a) x + $ G.elemseq (undefined :: Vector a) y z + +-- ------ +-- Tuples +-- ------ + +#define DEFINE_INSTANCES +#include "unbox-tuple-instances" diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Mutable.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Mutable.hs new file mode 100644 index 0000000000..cb82acea8f --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Mutable.hs @@ -0,0 +1,307 @@ +{-# LANGUAGE CPP #-} + +-- | +-- Module : Data.Vector.Unboxed.Mutable +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Mutable adaptive unboxed vectors +-- + +module Data.Vector.Unboxed.Mutable ( + -- * Mutable vectors of primitive types + MVector(..), IOVector, STVector, Unbox, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, clone, + + -- ** Growing + grow, unsafeGrow, + + -- ** Restricting memory usage + clear, + + -- * Zipping and unzipping + zip, zip3, zip4, zip5, zip6, + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Accessing individual elements + read, write, modify, swap, + unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, + + -- * Modifying vectors + nextPermutation, + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove +) where + +import Data.Vector.Unboxed.Base +import qualified Data.Vector.Generic.Mutable as G +import Data.Vector.Fusion.Util ( delayed_min ) +import Control.Monad.Primitive + +import Prelude hiding ( length, null, replicate, reverse, map, read, + take, drop, splitAt, init, tail, + zip, zip3, unzip, unzip3 ) + +-- don't import an unused Data.Vector.Internal.Check +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- Length information +-- ------------------ + +-- | Length of the mutable vector. +length :: Unbox a => MVector s a -> Int +{-# INLINE length #-} +length = G.length + +-- | Check whether the vector is empty +null :: Unbox a => MVector s a -> Bool +{-# INLINE null #-} +null = G.null + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. +slice :: Unbox a => Int -> Int -> MVector s a -> MVector s a +{-# INLINE slice #-} +slice = G.slice + +take :: Unbox a => Int -> MVector s a -> MVector s a +{-# INLINE take #-} +take = G.take + +drop :: Unbox a => Int -> MVector s a -> MVector s a +{-# INLINE drop #-} +drop = G.drop + +splitAt :: Unbox a => Int -> MVector s a -> (MVector s a, MVector s a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +init :: Unbox a => MVector s a -> MVector s a +{-# INLINE init #-} +init = G.init + +tail :: Unbox a => MVector s a -> MVector s a +{-# INLINE tail #-} +tail = G.tail + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +unsafeSlice :: Unbox a + => Int -- ^ starting index + -> Int -- ^ length of the slice + -> MVector s a + -> MVector s a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +unsafeTake :: Unbox a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +unsafeDrop :: Unbox a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +unsafeInit :: Unbox a => MVector s a -> MVector s a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +unsafeTail :: Unbox a => MVector s a -> MVector s a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +overlaps :: Unbox a => MVector s a -> MVector s a -> Bool +{-# INLINE overlaps #-} +overlaps = G.overlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +new :: (PrimMonad m, Unbox a) => Int -> m (MVector (PrimState m) a) +{-# INLINE new #-} +new = G.new + +-- | Create a mutable vector of the given length. The memory is not initialized. +unsafeNew :: (PrimMonad m, Unbox a) => Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew = G.unsafeNew + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +replicate :: (PrimMonad m, Unbox a) => Int -> a -> m (MVector (PrimState m) a) +{-# INLINE replicate #-} +replicate = G.replicate + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +replicateM :: (PrimMonad m, Unbox a) => Int -> m a -> m (MVector (PrimState m) a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | Create a copy of a mutable vector. +clone :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -> m (MVector (PrimState m) a) +{-# INLINE clone #-} +clone = G.clone + +-- Growing +-- ------- + +-- | Grow a vector by the given number of elements. The number must be +-- positive. +grow :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE grow #-} +grow = G.grow + +-- | Grow a vector by the given number of elements. The number must be +-- positive but this is not checked. +unsafeGrow :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow = G.unsafeGrow + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- references to external objects. This is usually a noop for unboxed vectors. +clear :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> m () +{-# INLINE clear #-} +clear = G.clear + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. +read :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read = G.read + +-- | Replace the element at the given position. +write :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE write #-} +write = G.write + +-- | Modify the element at the given position. +modify :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE modify #-} +modify = G.modify + +-- | Swap the elements at the given positions. +swap :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap = G.swap + + +-- | Yield the element at the given position. No bounds checks are performed. +unsafeRead :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +unsafeRead = G.unsafeRead + +-- | Replace the element at the given position. No bounds checks are performed. +unsafeWrite + :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE unsafeWrite #-} +unsafeWrite = G.unsafeWrite + +-- | Modify the element at the given position. No bounds checks are performed. +unsafeModify :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE unsafeModify #-} +unsafeModify = G.unsafeModify + +-- | Swap the elements at the given positions. No bounds checks are performed. +unsafeSwap + :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE unsafeSwap #-} +unsafeSwap = G.unsafeSwap + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +set :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> a -> m () +{-# INLINE set #-} +set = G.set + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +copy :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE copy #-} +copy = G.copy + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. This is not checked. +unsafeCopy :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | Move the contents of a vector. The two vectors must have the same +-- length. +-- +-- If the vectors do not overlap, then this is equivalent to 'copy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +move :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -> MVector (PrimState m) a -> m () +{-# INLINE move #-} +move = G.move + +-- | Move the contents of a vector. The two vectors must have the same +-- length, but this is not checked. +-- +-- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +unsafeMove :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove = G.unsafeMove + +-- | Compute the next (lexicographically) permutation of given vector in-place. +-- Returns False when input is the last permtuation +nextPermutation :: (PrimMonad m,Ord e,Unbox e) => MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutation #-} +nextPermutation = G.nextPermutation + +#define DEFINE_MUTABLE +#include "unbox-tuple-instances" diff --git a/third_party/bazel/rules_haskell/examples/vector/LICENSE b/third_party/bazel/rules_haskell/examples/vector/LICENSE new file mode 100644 index 0000000000..cafa68efb3 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2008-2012, Roman Leshchinskiy +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +- Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. + +- Neither name of the University nor the names of its contributors may be +used to endorse or promote products derived from this software without +specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF +GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH +DAMAGE. + diff --git a/third_party/bazel/rules_haskell/examples/vector/README.md b/third_party/bazel/rules_haskell/examples/vector/README.md new file mode 100644 index 0000000000..079dbd0b6b --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/README.md @@ -0,0 +1,6 @@ +The `vector` package [](https://travis-ci.org/haskell/vector) +==================== + +An efficient implementation of Int-indexed arrays (both mutable and immutable), with a powerful loop optimisation framework. + +See [`vector` on Hackage](http://hackage.haskell.org/package/vector) for more information. diff --git a/third_party/bazel/rules_haskell/examples/vector/Setup.hs b/third_party/bazel/rules_haskell/examples/vector/Setup.hs new file mode 100644 index 0000000000..200a2e51d0 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple +main = defaultMain + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/AwShCC.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/AwShCC.hs new file mode 100644 index 0000000000..404e289fae --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/AwShCC.hs @@ -0,0 +1,38 @@ +{-# OPTIONS -fno-spec-constr-count #-} +module Algo.AwShCC (awshcc) where + +import Data.Vector.Unboxed as V + +awshcc :: (Int, Vector Int, Vector Int) -> Vector Int +{-# NOINLINE awshcc #-} +awshcc (n, es1, es2) = concomp ds es1' es2' + where + ds = V.enumFromTo 0 (n-1) V.++ V.enumFromTo 0 (n-1) + es1' = es1 V.++ es2 + es2' = es2 V.++ es1 + + starCheck ds = V.backpermute st' gs + where + gs = V.backpermute ds ds + st = V.zipWith (==) ds gs + st' = V.update st . V.filter (not . snd) + $ V.zip gs st + + concomp ds es1 es2 + | V.and (starCheck ds'') = ds'' + | otherwise = concomp (V.backpermute ds'' ds'') es1 es2 + where + ds' = V.update ds + . V.map (\(di, dj, gi) -> (di, dj)) + . V.filter (\(di, dj, gi) -> gi == di && di > dj) + $ V.zip3 (V.backpermute ds es1) + (V.backpermute ds es2) + (V.backpermute ds (V.backpermute ds es1)) + + ds'' = V.update ds' + . V.map (\(di, dj, st) -> (di, dj)) + . V.filter (\(di, dj, st) -> st && di /= dj) + $ V.zip3 (V.backpermute ds' es1) + (V.backpermute ds' es2) + (V.backpermute (starCheck ds') es1) + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/HybCC.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/HybCC.hs new file mode 100644 index 0000000000..876d08f75b --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/HybCC.hs @@ -0,0 +1,42 @@ +module Algo.HybCC (hybcc) where + +import Data.Vector.Unboxed as V + +hybcc :: (Int, Vector Int, Vector Int) -> Vector Int +{-# NOINLINE hybcc #-} +hybcc (n, e1, e2) = concomp (V.zip e1 e2) n + where + concomp es n + | V.null es = V.enumFromTo 0 (n-1) + | otherwise = V.backpermute ins ins + where + p = shortcut_all + $ V.update (V.enumFromTo 0 (n-1)) es + + (es',i) = compress p es + r = concomp es' (V.length i) + ins = V.update_ p i + $ V.backpermute i r + + enumerate bs = V.prescanl' (+) 0 $ V.map (\b -> if b then 1 else 0) bs + + pack_index bs = V.map fst + . V.filter snd + $ V.zip (V.enumFromTo 0 (V.length bs - 1)) bs + + shortcut_all p | p == pp = pp + | otherwise = shortcut_all pp + where + pp = V.backpermute p p + + compress p es = (new_es, pack_index roots) + where + (e1,e2) = V.unzip es + es' = V.map (\(x,y) -> if x > y then (y,x) else (x,y)) + . V.filter (\(x,y) -> x /= y) + $ V.zip (V.backpermute p e1) (V.backpermute p e2) + + roots = V.zipWith (==) p (V.enumFromTo 0 (V.length p - 1)) + labels = enumerate roots + (e1',e2') = V.unzip es' + new_es = V.zip (V.backpermute labels e1') (V.backpermute labels e2') diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Leaffix.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Leaffix.hs new file mode 100644 index 0000000000..40ec517556 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Leaffix.hs @@ -0,0 +1,16 @@ +module Algo.Leaffix where + +import Data.Vector.Unboxed as V + +leaffix :: (Vector Int, Vector Int) -> Vector Int +{-# NOINLINE leaffix #-} +leaffix (ls,rs) + = leaffix (V.replicate (V.length ls) 1) ls rs + where + leaffix xs ls rs + = let zs = V.replicate (V.length ls * 2) 0 + vs = V.update_ zs ls xs + sums = V.prescanl' (+) 0 vs + in + V.zipWith (-) (V.backpermute sums ls) (V.backpermute sums rs) + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/ListRank.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/ListRank.hs new file mode 100644 index 0000000000..933bd8eb2e --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/ListRank.hs @@ -0,0 +1,21 @@ +module Algo.ListRank +where + +import Data.Vector.Unboxed as V + +listRank :: Int -> Vector Int +{-# NOINLINE listRank #-} +listRank n = pointer_jump xs val + where + xs = 0 `V.cons` V.enumFromTo 0 (n-2) + + val = V.zipWith (\i j -> if i == j then 0 else 1) + xs (V.enumFromTo 0 (n-1)) + + pointer_jump pt val + | npt == pt = val + | otherwise = pointer_jump npt nval + where + npt = V.backpermute pt pt + nval = V.zipWith (+) val (V.backpermute val pt) + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Quickhull.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Quickhull.hs new file mode 100644 index 0000000000..694bea3097 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Quickhull.hs @@ -0,0 +1,32 @@ +module Algo.Quickhull (quickhull) where + +import Data.Vector.Unboxed as V + +quickhull :: (Vector Double, Vector Double) -> (Vector Double, Vector Double) +{-# NOINLINE quickhull #-} +quickhull (xs, ys) = xs' `seq` ys' `seq` (xs',ys') + where + (xs',ys') = V.unzip + $ hsplit points pmin pmax V.++ hsplit points pmax pmin + + imin = V.minIndex xs + imax = V.maxIndex xs + + points = V.zip xs ys + pmin = points V.! imin + pmax = points V.! imax + + + hsplit points p1 p2 + | V.length packed < 2 = p1 `V.cons` packed + | otherwise = hsplit packed p1 pm V.++ hsplit packed pm p2 + where + cs = V.map (\p -> cross p p1 p2) points + packed = V.map fst + $ V.filter (\t -> snd t > 0) + $ V.zip points cs + + pm = points V.! V.maxIndex cs + + cross (x,y) (x1,y1) (x2,y2) = (x1-x)*(y2-y) - (y1-y)*(x2-x) + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Rootfix.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Rootfix.hs new file mode 100644 index 0000000000..1b112a801a --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Rootfix.hs @@ -0,0 +1,15 @@ +module Algo.Rootfix where + +import Data.Vector.Unboxed as V + +rootfix :: (V.Vector Int, V.Vector Int) -> V.Vector Int +{-# NOINLINE rootfix #-} +rootfix (ls, rs) = rootfix (V.replicate (V.length ls) 1) ls rs + where + rootfix xs ls rs + = let zs = V.replicate (V.length ls * 2) 0 + vs = V.update_ (V.update_ zs ls xs) rs (V.map negate xs) + sums = V.prescanl' (+) 0 vs + in + V.backpermute sums ls + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Spectral.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Spectral.hs new file mode 100644 index 0000000000..811c58269e --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Spectral.hs @@ -0,0 +1,21 @@ +module Algo.Spectral ( spectral ) where + +import Data.Vector.Unboxed as V + +import Data.Bits + +spectral :: Vector Double -> Vector Double +{-# NOINLINE spectral #-} +spectral us = us `seq` V.map row (V.enumFromTo 0 (n-1)) + where + n = V.length us + + row i = i `seq` V.sum (V.imap (\j u -> eval_A i j * u) us) + + eval_A i j = 1 / fromIntegral r + where + r = u + (i+1) + u = t `shiftR` 1 + t = n * (n+1) + n = i+j + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Tridiag.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Tridiag.hs new file mode 100644 index 0000000000..7668deace1 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Tridiag.hs @@ -0,0 +1,16 @@ +module Algo.Tridiag ( tridiag ) where + +import Data.Vector.Unboxed as V + +tridiag :: (Vector Double, Vector Double, Vector Double, Vector Double) + -> Vector Double +{-# NOINLINE tridiag #-} +tridiag (as,bs,cs,ds) = V.prescanr' (\(c,d) x' -> d - c*x') 0 + $ V.prescanl' modify (0,0) + $ V.zip (V.zip as bs) (V.zip cs ds) + where + modify (c',d') ((a,b),(c,d)) = + let id = 1 / (b - c'*a) + in + id `seq` (c*id, (d-d'*a)*id) + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/LICENSE b/third_party/bazel/rules_haskell/examples/vector/benchmarks/LICENSE new file mode 100644 index 0000000000..fc213a6ffb --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2008-2009, Roman Leshchinskiy +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +- Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. + +- Neither name of the University nor the names of its contributors may be +used to endorse or promote products derived from this software without +specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF +GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH +DAMAGE. + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Main.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Main.hs new file mode 100644 index 0000000000..65bd297a75 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Main.hs @@ -0,0 +1,46 @@ +module Main where + +import Criterion.Main + +import Algo.ListRank (listRank) +import Algo.Rootfix (rootfix) +import Algo.Leaffix (leaffix) +import Algo.AwShCC (awshcc) +import Algo.HybCC (hybcc) +import Algo.Quickhull (quickhull) +import Algo.Spectral ( spectral ) +import Algo.Tridiag ( tridiag ) + +import TestData.ParenTree ( parenTree ) +import TestData.Graph ( randomGraph ) +import TestData.Random ( randomVector ) + +import Data.Vector.Unboxed ( Vector ) + +size :: Int +size = 100000 + +main = lparens `seq` rparens `seq` + nodes `seq` edges1 `seq` edges2 `seq` + do + as <- randomVector size :: IO (Vector Double) + bs <- randomVector size :: IO (Vector Double) + cs <- randomVector size :: IO (Vector Double) + ds <- randomVector size :: IO (Vector Double) + sp <- randomVector (floor $ sqrt $ fromIntegral size) + :: IO (Vector Double) + as `seq` bs `seq` cs `seq` ds `seq` sp `seq` + defaultMain [ bench "listRank" $ whnf listRank size + , bench "rootfix" $ whnf rootfix (lparens, rparens) + , bench "leaffix" $ whnf leaffix (lparens, rparens) + , bench "awshcc" $ whnf awshcc (nodes, edges1, edges2) + , bench "hybcc" $ whnf hybcc (nodes, edges1, edges2) + , bench "quickhull" $ whnf quickhull (as,bs) + , bench "spectral" $ whnf spectral sp + , bench "tridiag" $ whnf tridiag (as,bs,cs,ds) + ] + where + (lparens, rparens) = parenTree size + (nodes, edges1, edges2) = randomGraph size + + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Setup.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Setup.hs new file mode 100644 index 0000000000..200a2e51d0 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple +main = defaultMain + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Graph.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Graph.hs new file mode 100644 index 0000000000..8b8ca837b8 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Graph.hs @@ -0,0 +1,45 @@ +module TestData.Graph ( randomGraph ) +where + +import System.Random.MWC +import qualified Data.Array.ST as STA +import qualified Data.Vector.Unboxed as V + +import Control.Monad.ST ( ST, runST ) + +randomGraph :: Int -> (Int, V.Vector Int, V.Vector Int) +randomGraph e + = runST ( + do + g <- create + arr <- STA.newArray (0,n-1) [] :: ST s (STA.STArray s Int [Int]) + addRandomEdges n g arr e + xs <- STA.getAssocs arr + let (as,bs) = unzip [(i,j) | (i,js) <- xs, j <- js ] + return (n, V.fromListN (length as) as, V.fromListN (length bs) bs) + ) + where + n = e `div` 10 + +addRandomEdges :: Int -> Gen s -> STA.STArray s Int [Int] -> Int -> ST s () +addRandomEdges n g arr = fill + where + fill 0 = return () + fill e + = do + m <- random_index + n <- random_index + let lo = min m n + hi = max m n + ns <- STA.readArray arr lo + if lo == hi || hi `elem` ns + then fill e + else do + STA.writeArray arr lo (hi:ns) + fill (e-1) + + random_index = do + x <- uniform g + let i = floor ((x::Double) * toEnum n) + if i == n then return 0 else return i + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/ParenTree.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/ParenTree.hs new file mode 100644 index 0000000000..4aeb750954 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/ParenTree.hs @@ -0,0 +1,20 @@ +module TestData.ParenTree where + +import qualified Data.Vector.Unboxed as V + +parenTree :: Int -> (V.Vector Int, V.Vector Int) +parenTree n = case go ([],[]) 0 (if even n then n else n+1) of + (ls,rs) -> (V.fromListN (length ls) (reverse ls), + V.fromListN (length rs) (reverse rs)) + where + go (ls,rs) i j = case j-i of + 0 -> (ls,rs) + 2 -> (ls',rs') + d -> let k = ((d-2) `div` 4) * 2 + in + go (go (ls',rs') (i+1) (i+1+k)) (i+1+k) (j-1) + where + ls' = i:ls + rs' = j-1:rs + + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Random.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Random.hs new file mode 100644 index 0000000000..f9b741fb97 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Random.hs @@ -0,0 +1,16 @@ +module TestData.Random ( randomVector ) where + +import qualified Data.Vector.Unboxed as V + +import System.Random.MWC +import Control.Monad.ST ( runST ) + +randomVector :: (Variate a, V.Unbox a) => Int -> IO (V.Vector a) +randomVector n = withSystemRandom $ \g -> + do + xs <- sequence $ replicate n $ uniform g + io (return $ V.fromListN n xs) + where + io :: IO a -> IO a + io = id + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/vector-benchmarks.cabal b/third_party/bazel/rules_haskell/examples/vector/benchmarks/vector-benchmarks.cabal new file mode 100644 index 0000000000..3e825c0fa4 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/vector-benchmarks.cabal @@ -0,0 +1,37 @@ +Name: vector-benchmarks +Version: 0.10.9 +License: BSD3 +License-File: LICENSE +Author: Roman Leshchinskiy <rl@cse.unsw.edu.au> +Maintainer: Roman Leshchinskiy <rl@cse.unsw.edu.au> +Copyright: (c) Roman Leshchinskiy 2010-2012 +Cabal-Version: >= 1.2 +Build-Type: Simple + +Executable algorithms + Main-Is: Main.hs + + Build-Depends: base >= 2 && < 5, array, + criterion >= 0.5 && < 0.7, + mwc-random >= 0.5 && < 0.13, + vector == 0.10.9 + + if impl(ghc<6.13) + Ghc-Options: -finline-if-enough-args -fno-method-sharing + + Ghc-Options: -O2 + + Other-Modules: + Algo.ListRank + Algo.Rootfix + Algo.Leaffix + Algo.AwShCC + Algo.HybCC + Algo.Quickhull + Algo.Spectral + Algo.Tridiag + + TestData.ParenTree + TestData.Graph + TestData.Random + diff --git a/third_party/bazel/rules_haskell/examples/vector/changelog b/third_party/bazel/rules_haskell/examples/vector/changelog new file mode 100644 index 0000000000..3d824b74d1 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/changelog @@ -0,0 +1,75 @@ +Changes in version 0.12.0.1 + + * Make sure `length` can be inlined + * Include modules that test-suites depend on in other-modules + +Changes in version 0.12.0.0 + + * Documentation fixes/additions + * New functions: createT, iscanl/r, iterateNM, unfoldrM, uniq + * New instances for various vector types: Semigroup, MonadZip + * Made `Storable` vectors respect memory alignment + * Changed some macros to ConstraintKinds + - Dropped compatibility with old GHCs to support this + * Add `Eq1`, `Ord1`, `Show1`, and `Read1` `Vector` instances, and related + helper functions. + * Relax context for `Unbox (Complex a)`. + +Changes in version 0.11.0.0 + + * Define `Applicative` instances for `Data.Vector.Fusion.Util.{Box,Id}` + * Define non-bottom `fail` for `instance Monad Vector` + * New generalized stream fusion framework + * Various safety fixes + - Various overflows due to vector size have been eliminated + - Memory is initialized on creation of unboxed vectors + * Changes to SPEC usage to allow building under more conditions + +Changes in version 0.10.12.3 + + * Allow building with `primtive-0.6` + +Changes in version 0.10.12.2 + + * Add support for `deepseq-1.4.0.0` + +Changes in version 0.10.12.1 + + * Fixed compilation on non-head GHCs + +Changes in version 0.10.12.0 + + * Export MVector constructor from Data.Vector.Primitive to match Vector's + (which was already exported). + + * Fix building on GHC 7.9 by adding Applicative instances for Id and Box + +Changes in version 0.10.11.0 + + * Support OverloadedLists for boxed Vector in GHC >= 7.8 + +Changes in version 0.10.10.0 + + * Minor version bump to rectify PVP violation occured in 0.10.9.3 release + +Changes in version 0.10.9.3 (deprecated) + + * Add support for OverloadedLists in GHC >= 7.8 + +Changes in version 0.10.9.2 + + * Fix compilation with GHC 7.9 + +Changes in version 0.10.9.1 + + * Implement poly-kinded Typeable + +Changes in version 0.10.0.1 + + * Require `primitive` to include workaround for a GHC array copying bug + +Changes in version 0.10 + + * `NFData` instances + * More efficient block fills + * Safe Haskell support removed diff --git a/third_party/bazel/rules_haskell/examples/vector/include/vector.h b/third_party/bazel/rules_haskell/examples/vector/include/vector.h new file mode 100644 index 0000000000..1568bb2906 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/include/vector.h @@ -0,0 +1,20 @@ +#define PHASE_FUSED [1] +#define PHASE_INNER [0] + +#define INLINE_FUSED INLINE PHASE_FUSED +#define INLINE_INNER INLINE PHASE_INNER + +#ifndef NOT_VECTOR_MODULE +import qualified Data.Vector.Internal.Check as Ck +#endif + +#define ERROR (Ck.error __FILE__ __LINE__) +#define INTERNAL_ERROR (Ck.internalError __FILE__ __LINE__) + +#define CHECK(f) (Ck.f __FILE__ __LINE__) +#define BOUNDS_CHECK(f) (CHECK(f) Ck.Bounds) +#define UNSAFE_CHECK(f) (CHECK(f) Ck.Unsafe) +#define INTERNAL_CHECK(f) (CHECK(f) Ck.Internal) + +#define PHASE_STREAM Please use "PHASE_FUSED" instead +#define INLINE_STREAM Please use "INLINE_FUSED" instead diff --git a/third_party/bazel/rules_haskell/examples/vector/internal/GenUnboxTuple.hs b/third_party/bazel/rules_haskell/examples/vector/internal/GenUnboxTuple.hs new file mode 100644 index 0000000000..8debff23a9 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/internal/GenUnboxTuple.hs @@ -0,0 +1,239 @@ +{-# LANGUAGE ParallelListComp #-} +module Main where + +import Text.PrettyPrint + +import System.Environment ( getArgs ) + +main = do + [s] <- getArgs + let n = read s + mapM_ (putStrLn . render . generate) [2..n] + +generate :: Int -> Doc +generate n = + vcat [ text "#ifdef DEFINE_INSTANCES" + , data_instance "MVector s" "MV" + , data_instance "Vector" "V" + , class_instance "Unbox" + , class_instance "M.MVector MVector" <+> text "where" + , nest 2 $ vcat $ map method methods_MVector + , class_instance "G.Vector Vector" <+> text "where" + , nest 2 $ vcat $ map method methods_Vector + , text "#endif" + , text "#ifdef DEFINE_MUTABLE" + , define_zip "MVector s" "MV" + , define_unzip "MVector s" "MV" + , text "#endif" + , text "#ifdef DEFINE_IMMUTABLE" + , define_zip "Vector" "V" + , define_zip_rule + , define_unzip "Vector" "V" + , text "#endif" + ] + + where + vars = map (\c -> text ['_',c]) $ take n ['a'..] + varss = map (<> char 's') vars + tuple xs = parens $ hsep $ punctuate comma xs + vtuple xs = parens $ sep $ punctuate comma xs + con s = text s <> char '_' <> int n + var c = text ('_' : c : "_") + + data_instance ty c + = hang (hsep [text "data instance", text ty, tuple vars]) + 4 + (hsep [char '=', con c, text "{-# UNPACK #-} !Int" + , vcat $ map (\v -> char '!' <> parens (text ty <+> v)) vars]) + + class_instance cls + = text "instance" <+> vtuple [text "Unbox" <+> v | v <- vars] + <+> text "=>" <+> text cls <+> tuple vars + + + define_zip ty c + = sep [text "-- | /O(1)/ Zip" <+> int n <+> text "vectors" + ,name <+> text "::" + <+> vtuple [text "Unbox" <+> v | v <- vars] + <+> text "=>" + <+> sep (punctuate (text " ->") [text ty <+> v | v <- vars]) + <+> text "->" + <+> text ty <+> tuple vars + ,text "{-# INLINE_FUSED" <+> name <+> text "#-}" + ,name <+> sep varss + <+> text "=" + <+> con c + <+> text "len" + <+> sep [parens $ text "unsafeSlice" + <+> char '0' + <+> text "len" + <+> vs | vs <- varss] + ,nest 2 $ hang (text "where") + 2 + $ text "len =" + <+> sep (punctuate (text " `delayed_min`") + [text "length" <+> vs | vs <- varss]) + ] + where + name | n == 2 = text "zip" + | otherwise = text "zip" <> int n + + define_zip_rule + = hang (text "{-# RULES" <+> text "\"stream/" <> name "zip" + <> text " [Vector.Unboxed]\" forall" <+> sep varss <+> char '.') + 2 $ + text "G.stream" <+> parens (name "zip" <+> sep varss) + <+> char '=' + <+> text "Bundle." <> name "zipWith" <+> tuple (replicate n empty) + <+> sep [parens $ text "G.stream" <+> vs | vs <- varss] + $$ text "#-}" + where + name s | n == 2 = text s + | otherwise = text s <> int n + + + define_unzip ty c + = sep [text "-- | /O(1)/ Unzip" <+> int n <+> text "vectors" + ,name <+> text "::" + <+> vtuple [text "Unbox" <+> v | v <- vars] + <+> text "=>" + <+> text ty <+> tuple vars + <+> text "->" <+> vtuple [text ty <+> v | v <- vars] + ,text "{-# INLINE" <+> name <+> text "#-}" + ,name <+> pat c <+> text "=" + <+> vtuple varss + ] + where + name | n == 2 = text "unzip" + | otherwise = text "unzip" <> int n + + pat c = parens $ con c <+> var 'n' <+> sep varss + patn c n = parens $ con c <+> (var 'n' <> int n) + <+> sep [v <> int n | v <- varss] + + qM s = text "M." <> text s + qG s = text "G." <> text s + + gen_length c _ = (pat c, var 'n') + + gen_unsafeSlice mod c rec + = (var 'i' <+> var 'm' <+> pat c, + con c <+> var 'm' + <+> vcat [parens + $ text mod <> char '.' <> text rec + <+> var 'i' <+> var 'm' <+> vs + | vs <- varss]) + + + gen_overlaps rec = (patn "MV" 1 <+> patn "MV" 2, + vcat $ r : [text "||" <+> r | r <- rs]) + where + r : rs = [qM rec <+> v <> char '1' <+> v <> char '2' | v <- varss] + + gen_unsafeNew rec + = (var 'n', + mk_do [v <+> text "<-" <+> qM rec <+> var 'n' | v <- varss] + $ text "return $" <+> con "MV" <+> var 'n' <+> sep varss) + + gen_unsafeReplicate rec + = (var 'n' <+> tuple vars, + mk_do [vs <+> text "<-" <+> qM rec <+> var 'n' <+> v + | v <- vars | vs <- varss] + $ text "return $" <+> con "MV" <+> var 'n' <+> sep varss) + + gen_unsafeRead rec + = (pat "MV" <+> var 'i', + mk_do [v <+> text "<-" <+> qM rec <+> vs <+> var 'i' | v <- vars + | vs <- varss] + $ text "return" <+> tuple vars) + + gen_unsafeWrite rec + = (pat "MV" <+> var 'i' <+> tuple vars, + mk_do [qM rec <+> vs <+> var 'i' <+> v | v <- vars | vs <- varss] + empty) + + gen_clear rec + = (pat "MV", mk_do [qM rec <+> vs | vs <- varss] empty) + + gen_set rec + = (pat "MV" <+> tuple vars, + mk_do [qM rec <+> vs <+> v | vs <- varss | v <- vars] empty) + + gen_unsafeCopy c q rec + = (patn "MV" 1 <+> patn c 2, + mk_do [q rec <+> vs <> char '1' <+> vs <> char '2' | vs <- varss] + empty) + + gen_unsafeMove rec + = (patn "MV" 1 <+> patn "MV" 2, + mk_do [qM rec <+> vs <> char '1' <+> vs <> char '2' | vs <- varss] + empty) + + gen_unsafeGrow rec + = (pat "MV" <+> var 'm', + mk_do [vs <> char '\'' <+> text "<-" + <+> qM rec <+> vs <+> var 'm' | vs <- varss] + $ text "return $" <+> con "MV" + <+> parens (var 'm' <> char '+' <> var 'n') + <+> sep (map (<> char '\'') varss)) + + gen_initialize rec + = (pat "MV", mk_do [qM rec <+> vs | vs <- varss] empty) + + gen_unsafeFreeze rec + = (pat "MV", + mk_do [vs <> char '\'' <+> text "<-" <+> qG rec <+> vs | vs <- varss] + $ text "return $" <+> con "V" <+> var 'n' + <+> sep [vs <> char '\'' | vs <- varss]) + + gen_unsafeThaw rec + = (pat "V", + mk_do [vs <> char '\'' <+> text "<-" <+> qG rec <+> vs | vs <- varss] + $ text "return $" <+> con "MV" <+> var 'n' + <+> sep [vs <> char '\'' | vs <- varss]) + + gen_basicUnsafeIndexM rec + = (pat "V" <+> var 'i', + mk_do [v <+> text "<-" <+> qG rec <+> vs <+> var 'i' + | vs <- varss | v <- vars] + $ text "return" <+> tuple vars) + + gen_elemseq rec + = (char '_' <+> tuple vars, + vcat $ r : [char '.' <+> r | r <- rs]) + where + r : rs = [qG rec <+> parens (text "undefined :: Vector" <+> v) + <+> v | v <- vars] + + mk_do cmds ret = hang (text "do") + 2 + $ vcat $ cmds ++ [ret] + + method (s, f) = case f s of + (p,e) -> text "{-# INLINE" <+> text s <+> text " #-}" + $$ hang (text s <+> p) + 4 + (char '=' <+> e) + + + methods_MVector = [("basicLength", gen_length "MV") + ,("basicUnsafeSlice", gen_unsafeSlice "M" "MV") + ,("basicOverlaps", gen_overlaps) + ,("basicUnsafeNew", gen_unsafeNew) + ,("basicUnsafeReplicate", gen_unsafeReplicate) + ,("basicUnsafeRead", gen_unsafeRead) + ,("basicUnsafeWrite", gen_unsafeWrite) + ,("basicClear", gen_clear) + ,("basicSet", gen_set) + ,("basicUnsafeCopy", gen_unsafeCopy "MV" qM) + ,("basicUnsafeMove", gen_unsafeMove) + ,("basicUnsafeGrow", gen_unsafeGrow) + ,("basicInitialize", gen_initialize)] + + methods_Vector = [("basicUnsafeFreeze", gen_unsafeFreeze) + ,("basicUnsafeThaw", gen_unsafeThaw) + ,("basicLength", gen_length "V") + ,("basicUnsafeSlice", gen_unsafeSlice "G" "V") + ,("basicUnsafeIndexM", gen_basicUnsafeIndexM) + ,("basicUnsafeCopy", gen_unsafeCopy "V" qG) + ,("elemseq", gen_elemseq)] diff --git a/third_party/bazel/rules_haskell/examples/vector/internal/unbox-tuple-instances b/third_party/bazel/rules_haskell/examples/vector/internal/unbox-tuple-instances new file mode 100644 index 0000000000..6fb88d4a40 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/internal/unbox-tuple-instances @@ -0,0 +1,1134 @@ +#ifdef DEFINE_INSTANCES +data instance MVector s (a, b) + = MV_2 {-# UNPACK #-} !Int !(MVector s a) + !(MVector s b) +data instance Vector (a, b) + = V_2 {-# UNPACK #-} !Int !(Vector a) + !(Vector b) +instance (Unbox a, Unbox b) => Unbox (a, b) +instance (Unbox a, Unbox b) => M.MVector MVector (a, b) where + {-# INLINE basicLength #-} + basicLength (MV_2 n_ _ _) = n_ + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice i_ m_ (MV_2 _ as bs) + = MV_2 m_ (M.basicUnsafeSlice i_ m_ as) + (M.basicUnsafeSlice i_ m_ bs) + {-# INLINE basicOverlaps #-} + basicOverlaps (MV_2 _ as1 bs1) (MV_2 _ as2 bs2) + = M.basicOverlaps as1 as2 + || M.basicOverlaps bs1 bs2 + {-# INLINE basicUnsafeNew #-} + basicUnsafeNew n_ + = do + as <- M.basicUnsafeNew n_ + bs <- M.basicUnsafeNew n_ + return $ MV_2 n_ as bs + {-# INLINE basicInitialize #-} + basicInitialize (MV_2 _ as bs) + = do + M.basicInitialize as + M.basicInitialize bs + {-# INLINE basicUnsafeReplicate #-} + basicUnsafeReplicate n_ (a, b) + = do + as <- M.basicUnsafeReplicate n_ a + bs <- M.basicUnsafeReplicate n_ b + return $ MV_2 n_ as bs + {-# INLINE basicUnsafeRead #-} + basicUnsafeRead (MV_2 _ as bs) i_ + = do + a <- M.basicUnsafeRead as i_ + b <- M.basicUnsafeRead bs i_ + return (a, b) + {-# INLINE basicUnsafeWrite #-} + basicUnsafeWrite (MV_2 _ as bs) i_ (a, b) + = do + M.basicUnsafeWrite as i_ a + M.basicUnsafeWrite bs i_ b + {-# INLINE basicClear #-} + basicClear (MV_2 _ as bs) + = do + M.basicClear as + M.basicClear bs + {-# INLINE basicSet #-} + basicSet (MV_2 _ as bs) (a, b) + = do + M.basicSet as a + M.basicSet bs b + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MV_2 _ as1 bs1) (MV_2 _ as2 bs2) + = do + M.basicUnsafeCopy as1 as2 + M.basicUnsafeCopy bs1 bs2 + {-# INLINE basicUnsafeMove #-} + basicUnsafeMove (MV_2 _ as1 bs1) (MV_2 _ as2 bs2) + = do + M.basicUnsafeMove as1 as2 + M.basicUnsafeMove bs1 bs2 + {-# INLINE basicUnsafeGrow #-} + basicUnsafeGrow (MV_2 n_ as bs) m_ + = do + as' <- M.basicUnsafeGrow as m_ + bs' <- M.basicUnsafeGrow bs m_ + return $ MV_2 (m_+n_) as' bs' +instance (Unbox a, Unbox b) => G.Vector Vector (a, b) where + {-# INLINE basicUnsafeFreeze #-} + basicUnsafeFreeze (MV_2 n_ as bs) + = do + as' <- G.basicUnsafeFreeze as + bs' <- G.basicUnsafeFreeze bs + return $ V_2 n_ as' bs' + {-# INLINE basicUnsafeThaw #-} + basicUnsafeThaw (V_2 n_ as bs) + = do + as' <- G.basicUnsafeThaw as + bs' <- G.basicUnsafeThaw bs + return $ MV_2 n_ as' bs' + {-# INLINE basicLength #-} + basicLength (V_2 n_ _ _) = n_ + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice i_ m_ (V_2 _ as bs) + = V_2 m_ (G.basicUnsafeSlice i_ m_ as) + (G.basicUnsafeSlice i_ m_ bs) + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM (V_2 _ as bs) i_ + = do + a <- G.basicUnsafeIndexM as i_ + b <- G.basicUnsafeIndexM bs i_ + return (a, b) + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MV_2 _ as1 bs1) (V_2 _ as2 bs2) + = do + G.basicUnsafeCopy as1 as2 + G.basicUnsafeCopy bs1 bs2 + {-# INLINE elemseq #-} + elemseq _ (a, b) + = G.elemseq (undefined :: Vector a) a + . G.elemseq (undefined :: Vector b) b +#endif +#ifdef DEFINE_MUTABLE +-- | /O(1)/ Zip 2 vectors +zip :: (Unbox a, Unbox b) => MVector s a -> + MVector s b -> MVector s (a, b) +{-# INLINE_FUSED zip #-} +zip as bs = MV_2 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) + where len = length as `delayed_min` length bs +-- | /O(1)/ Unzip 2 vectors +unzip :: (Unbox a, Unbox b) => MVector s (a, b) -> (MVector s a, + MVector s b) +{-# INLINE unzip #-} +unzip (MV_2 _ as bs) = (as, bs) +#endif +#ifdef DEFINE_IMMUTABLE +-- | /O(1)/ Zip 2 vectors +zip :: (Unbox a, Unbox b) => Vector a -> Vector b -> Vector (a, b) +{-# INLINE_FUSED zip #-} +zip as bs = V_2 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) + where len = length as `delayed_min` length bs +{-# RULES "stream/zip [Vector.Unboxed]" forall as bs . + G.stream (zip as bs) = Bundle.zipWith (,) (G.stream as) + (G.stream bs) #-} + +-- | /O(1)/ Unzip 2 vectors +unzip :: (Unbox a, Unbox b) => Vector (a, b) -> (Vector a, + Vector b) +{-# INLINE unzip #-} +unzip (V_2 _ as bs) = (as, bs) +#endif +#ifdef DEFINE_INSTANCES +data instance MVector s (a, b, c) + = MV_3 {-# UNPACK #-} !Int !(MVector s a) + !(MVector s b) + !(MVector s c) +data instance Vector (a, b, c) + = V_3 {-# UNPACK #-} !Int !(Vector a) + !(Vector b) + !(Vector c) +instance (Unbox a, Unbox b, Unbox c) => Unbox (a, b, c) +instance (Unbox a, + Unbox b, + Unbox c) => M.MVector MVector (a, b, c) where + {-# INLINE basicLength #-} + basicLength (MV_3 n_ _ _ _) = n_ + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice i_ m_ (MV_3 _ as bs cs) + = MV_3 m_ (M.basicUnsafeSlice i_ m_ as) + (M.basicUnsafeSlice i_ m_ bs) + (M.basicUnsafeSlice i_ m_ cs) + {-# INLINE basicOverlaps #-} + basicOverlaps (MV_3 _ as1 bs1 cs1) (MV_3 _ as2 bs2 cs2) + = M.basicOverlaps as1 as2 + || M.basicOverlaps bs1 bs2 + || M.basicOverlaps cs1 cs2 + {-# INLINE basicUnsafeNew #-} + basicUnsafeNew n_ + = do + as <- M.basicUnsafeNew n_ + bs <- M.basicUnsafeNew n_ + cs <- M.basicUnsafeNew n_ + return $ MV_3 n_ as bs cs + {-# INLINE basicInitialize #-} + basicInitialize (MV_3 _ as bs cs) + = do + M.basicInitialize as + M.basicInitialize bs + M.basicInitialize cs + {-# INLINE basicUnsafeReplicate #-} + basicUnsafeReplicate n_ (a, b, c) + = do + as <- M.basicUnsafeReplicate n_ a + bs <- M.basicUnsafeReplicate n_ b + cs <- M.basicUnsafeReplicate n_ c + return $ MV_3 n_ as bs cs + {-# INLINE basicUnsafeRead #-} + basicUnsafeRead (MV_3 _ as bs cs) i_ + = do + a <- M.basicUnsafeRead as i_ + b <- M.basicUnsafeRead bs i_ + c <- M.basicUnsafeRead cs i_ + return (a, b, c) + {-# INLINE basicUnsafeWrite #-} + basicUnsafeWrite (MV_3 _ as bs cs) i_ (a, b, c) + = do + M.basicUnsafeWrite as i_ a + M.basicUnsafeWrite bs i_ b + M.basicUnsafeWrite cs i_ c + {-# INLINE basicClear #-} + basicClear (MV_3 _ as bs cs) + = do + M.basicClear as + M.basicClear bs + M.basicClear cs + {-# INLINE basicSet #-} + basicSet (MV_3 _ as bs cs) (a, b, c) + = do + M.basicSet as a + M.basicSet bs b + M.basicSet cs c + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MV_3 _ as1 bs1 cs1) (MV_3 _ as2 bs2 cs2) + = do + M.basicUnsafeCopy as1 as2 + M.basicUnsafeCopy bs1 bs2 + M.basicUnsafeCopy cs1 cs2 + {-# INLINE basicUnsafeMove #-} + basicUnsafeMove (MV_3 _ as1 bs1 cs1) (MV_3 _ as2 bs2 cs2) + = do + M.basicUnsafeMove as1 as2 + M.basicUnsafeMove bs1 bs2 + M.basicUnsafeMove cs1 cs2 + {-# INLINE basicUnsafeGrow #-} + basicUnsafeGrow (MV_3 n_ as bs cs) m_ + = do + as' <- M.basicUnsafeGrow as m_ + bs' <- M.basicUnsafeGrow bs m_ + cs' <- M.basicUnsafeGrow cs m_ + return $ MV_3 (m_+n_) as' bs' cs' +instance (Unbox a, + Unbox b, + Unbox c) => G.Vector Vector (a, b, c) where + {-# INLINE basicUnsafeFreeze #-} + basicUnsafeFreeze (MV_3 n_ as bs cs) + = do + as' <- G.basicUnsafeFreeze as + bs' <- G.basicUnsafeFreeze bs + cs' <- G.basicUnsafeFreeze cs + return $ V_3 n_ as' bs' cs' + {-# INLINE basicUnsafeThaw #-} + basicUnsafeThaw (V_3 n_ as bs cs) + = do + as' <- G.basicUnsafeThaw as + bs' <- G.basicUnsafeThaw bs + cs' <- G.basicUnsafeThaw cs + return $ MV_3 n_ as' bs' cs' + {-# INLINE basicLength #-} + basicLength (V_3 n_ _ _ _) = n_ + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice i_ m_ (V_3 _ as bs cs) + = V_3 m_ (G.basicUnsafeSlice i_ m_ as) + (G.basicUnsafeSlice i_ m_ bs) + (G.basicUnsafeSlice i_ m_ cs) + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM (V_3 _ as bs cs) i_ + = do + a <- G.basicUnsafeIndexM as i_ + b <- G.basicUnsafeIndexM bs i_ + c <- G.basicUnsafeIndexM cs i_ + return (a, b, c) + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MV_3 _ as1 bs1 cs1) (V_3 _ as2 bs2 cs2) + = do + G.basicUnsafeCopy as1 as2 + G.basicUnsafeCopy bs1 bs2 + G.basicUnsafeCopy cs1 cs2 + {-# INLINE elemseq #-} + elemseq _ (a, b, c) + = G.elemseq (undefined :: Vector a) a + . G.elemseq (undefined :: Vector b) b + . G.elemseq (undefined :: Vector c) c +#endif +#ifdef DEFINE_MUTABLE +-- | /O(1)/ Zip 3 vectors +zip3 :: (Unbox a, Unbox b, Unbox c) => MVector s a -> + MVector s b -> + MVector s c -> MVector s (a, b, c) +{-# INLINE_FUSED zip3 #-} +zip3 as bs cs = MV_3 len (unsafeSlice 0 len as) + (unsafeSlice 0 len bs) + (unsafeSlice 0 len cs) + where + len = length as `delayed_min` length bs `delayed_min` length cs +-- | /O(1)/ Unzip 3 vectors +unzip3 :: (Unbox a, + Unbox b, + Unbox c) => MVector s (a, b, c) -> (MVector s a, + MVector s b, + MVector s c) +{-# INLINE unzip3 #-} +unzip3 (MV_3 _ as bs cs) = (as, bs, cs) +#endif +#ifdef DEFINE_IMMUTABLE +-- | /O(1)/ Zip 3 vectors +zip3 :: (Unbox a, Unbox b, Unbox c) => Vector a -> + Vector b -> + Vector c -> Vector (a, b, c) +{-# INLINE_FUSED zip3 #-} +zip3 as bs cs = V_3 len (unsafeSlice 0 len as) + (unsafeSlice 0 len bs) + (unsafeSlice 0 len cs) + where + len = length as `delayed_min` length bs `delayed_min` length cs +{-# RULES "stream/zip3 [Vector.Unboxed]" forall as bs cs . + G.stream (zip3 as bs cs) = Bundle.zipWith3 (, ,) (G.stream as) + (G.stream bs) + (G.stream cs) #-} + +-- | /O(1)/ Unzip 3 vectors +unzip3 :: (Unbox a, + Unbox b, + Unbox c) => Vector (a, b, c) -> (Vector a, Vector b, Vector c) +{-# INLINE unzip3 #-} +unzip3 (V_3 _ as bs cs) = (as, bs, cs) +#endif +#ifdef DEFINE_INSTANCES +data instance MVector s (a, b, c, d) + = MV_4 {-# UNPACK #-} !Int !(MVector s a) + !(MVector s b) + !(MVector s c) + !(MVector s d) +data instance Vector (a, b, c, d) + = V_4 {-# UNPACK #-} !Int !(Vector a) + !(Vector b) + !(Vector c) + !(Vector d) +instance (Unbox a, Unbox b, Unbox c, Unbox d) => Unbox (a, b, c, d) +instance (Unbox a, + Unbox b, + Unbox c, + Unbox d) => M.MVector MVector (a, b, c, d) where + {-# INLINE basicLength #-} + basicLength (MV_4 n_ _ _ _ _) = n_ + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice i_ m_ (MV_4 _ as bs cs ds) + = MV_4 m_ (M.basicUnsafeSlice i_ m_ as) + (M.basicUnsafeSlice i_ m_ bs) + (M.basicUnsafeSlice i_ m_ cs) + (M.basicUnsafeSlice i_ m_ ds) + {-# INLINE basicOverlaps #-} + basicOverlaps (MV_4 _ as1 bs1 cs1 ds1) (MV_4 _ as2 bs2 cs2 ds2) + = M.basicOverlaps as1 as2 + || M.basicOverlaps bs1 bs2 + || M.basicOverlaps cs1 cs2 + || M.basicOverlaps ds1 ds2 + {-# INLINE basicUnsafeNew #-} + basicUnsafeNew n_ + = do + as <- M.basicUnsafeNew n_ + bs <- M.basicUnsafeNew n_ + cs <- M.basicUnsafeNew n_ + ds <- M.basicUnsafeNew n_ + return $ MV_4 n_ as bs cs ds + {-# INLINE basicInitialize #-} + basicInitialize (MV_4 _ as bs cs ds) + = do + M.basicInitialize as + M.basicInitialize bs + M.basicInitialize cs + M.basicInitialize ds + {-# INLINE basicUnsafeReplicate #-} + basicUnsafeReplicate n_ (a, b, c, d) + = do + as <- M.basicUnsafeReplicate n_ a + bs <- M.basicUnsafeReplicate n_ b + cs <- M.basicUnsafeReplicate n_ c + ds <- M.basicUnsafeReplicate n_ d + return $ MV_4 n_ as bs cs ds + {-# INLINE basicUnsafeRead #-} + basicUnsafeRead (MV_4 _ as bs cs ds) i_ + = do + a <- M.basicUnsafeRead as i_ + b <- M.basicUnsafeRead bs i_ + c <- M.basicUnsafeRead cs i_ + d <- M.basicUnsafeRead ds i_ + return (a, b, c, d) + {-# INLINE basicUnsafeWrite #-} + basicUnsafeWrite (MV_4 _ as bs cs ds) i_ (a, b, c, d) + = do + M.basicUnsafeWrite as i_ a + M.basicUnsafeWrite bs i_ b + M.basicUnsafeWrite cs i_ c + M.basicUnsafeWrite ds i_ d + {-# INLINE basicClear #-} + basicClear (MV_4 _ as bs cs ds) + = do + M.basicClear as + M.basicClear bs + M.basicClear cs + M.basicClear ds + {-# INLINE basicSet #-} + basicSet (MV_4 _ as bs cs ds) (a, b, c, d) + = do + M.basicSet as a + M.basicSet bs b + M.basicSet cs c + M.basicSet ds d + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MV_4 _ as1 bs1 cs1 ds1) (MV_4 _ as2 + bs2 + cs2 + ds2) + = do + M.basicUnsafeCopy as1 as2 + M.basicUnsafeCopy bs1 bs2 + M.basicUnsafeCopy cs1 cs2 + M.basicUnsafeCopy ds1 ds2 + {-# INLINE basicUnsafeMove #-} + basicUnsafeMove (MV_4 _ as1 bs1 cs1 ds1) (MV_4 _ as2 + bs2 + cs2 + ds2) + = do + M.basicUnsafeMove as1 as2 + M.basicUnsafeMove bs1 bs2 + M.basicUnsafeMove cs1 cs2 + M.basicUnsafeMove ds1 ds2 + {-# INLINE basicUnsafeGrow #-} + basicUnsafeGrow (MV_4 n_ as bs cs ds) m_ + = do + as' <- M.basicUnsafeGrow as m_ + bs' <- M.basicUnsafeGrow bs m_ + cs' <- M.basicUnsafeGrow cs m_ + ds' <- M.basicUnsafeGrow ds m_ + return $ MV_4 (m_+n_) as' bs' cs' ds' +instance (Unbox a, + Unbox b, + Unbox c, + Unbox d) => G.Vector Vector (a, b, c, d) where + {-# INLINE basicUnsafeFreeze #-} + basicUnsafeFreeze (MV_4 n_ as bs cs ds) + = do + as' <- G.basicUnsafeFreeze as + bs' <- G.basicUnsafeFreeze bs + cs' <- G.basicUnsafeFreeze cs + ds' <- G.basicUnsafeFreeze ds + return $ V_4 n_ as' bs' cs' ds' + {-# INLINE basicUnsafeThaw #-} + basicUnsafeThaw (V_4 n_ as bs cs ds) + = do + as' <- G.basicUnsafeThaw as + bs' <- G.basicUnsafeThaw bs + cs' <- G.basicUnsafeThaw cs + ds' <- G.basicUnsafeThaw ds + return $ MV_4 n_ as' bs' cs' ds' + {-# INLINE basicLength #-} + basicLength (V_4 n_ _ _ _ _) = n_ + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice i_ m_ (V_4 _ as bs cs ds) + = V_4 m_ (G.basicUnsafeSlice i_ m_ as) + (G.basicUnsafeSlice i_ m_ bs) + (G.basicUnsafeSlice i_ m_ cs) + (G.basicUnsafeSlice i_ m_ ds) + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM (V_4 _ as bs cs ds) i_ + = do + a <- G.basicUnsafeIndexM as i_ + b <- G.basicUnsafeIndexM bs i_ + c <- G.basicUnsafeIndexM cs i_ + d <- G.basicUnsafeIndexM ds i_ + return (a, b, c, d) + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MV_4 _ as1 bs1 cs1 ds1) (V_4 _ as2 + bs2 + cs2 + ds2) + = do + G.basicUnsafeCopy as1 as2 + G.basicUnsafeCopy bs1 bs2 + G.basicUnsafeCopy cs1 cs2 + G.basicUnsafeCopy ds1 ds2 + {-# INLINE elemseq #-} + elemseq _ (a, b, c, d) + = G.elemseq (undefined :: Vector a) a + . G.elemseq (undefined :: Vector b) b + . G.elemseq (undefined :: Vector c) c + . G.elemseq (undefined :: Vector d) d +#endif +#ifdef DEFINE_MUTABLE +-- | /O(1)/ Zip 4 vectors +zip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => MVector s a -> + MVector s b -> + MVector s c -> + MVector s d -> MVector s (a, b, c, d) +{-# INLINE_FUSED zip4 #-} +zip4 as bs cs ds = MV_4 len (unsafeSlice 0 len as) + (unsafeSlice 0 len bs) + (unsafeSlice 0 len cs) + (unsafeSlice 0 len ds) + where + len = length as `delayed_min` + length bs `delayed_min` + length cs `delayed_min` + length ds +-- | /O(1)/ Unzip 4 vectors +unzip4 :: (Unbox a, + Unbox b, + Unbox c, + Unbox d) => MVector s (a, b, c, d) -> (MVector s a, + MVector s b, + MVector s c, + MVector s d) +{-# INLINE unzip4 #-} +unzip4 (MV_4 _ as bs cs ds) = (as, bs, cs, ds) +#endif +#ifdef DEFINE_IMMUTABLE +-- | /O(1)/ Zip 4 vectors +zip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => Vector a -> + Vector b -> + Vector c -> + Vector d -> Vector (a, b, c, d) +{-# INLINE_FUSED zip4 #-} +zip4 as bs cs ds = V_4 len (unsafeSlice 0 len as) + (unsafeSlice 0 len bs) + (unsafeSlice 0 len cs) + (unsafeSlice 0 len ds) + where + len = length as `delayed_min` + length bs `delayed_min` + length cs `delayed_min` + length ds +{-# RULES "stream/zip4 [Vector.Unboxed]" forall as bs cs ds . + G.stream (zip4 as bs cs ds) = Bundle.zipWith4 (, , ,) (G.stream as) + (G.stream bs) + (G.stream cs) + (G.stream ds) #-} + +-- | /O(1)/ Unzip 4 vectors +unzip4 :: (Unbox a, + Unbox b, + Unbox c, + Unbox d) => Vector (a, b, c, d) -> (Vector a, + Vector b, + Vector c, + Vector d) +{-# INLINE unzip4 #-} +unzip4 (V_4 _ as bs cs ds) = (as, bs, cs, ds) +#endif +#ifdef DEFINE_INSTANCES +data instance MVector s (a, b, c, d, e) + = MV_5 {-# UNPACK #-} !Int !(MVector s a) + !(MVector s b) + !(MVector s c) + !(MVector s d) + !(MVector s e) +data instance Vector (a, b, c, d, e) + = V_5 {-# UNPACK #-} !Int !(Vector a) + !(Vector b) + !(Vector c) + !(Vector d) + !(Vector e) +instance (Unbox a, + Unbox b, + Unbox c, + Unbox d, + Unbox e) => Unbox (a, b, c, d, e) +instance (Unbox a, + Unbox b, + Unbox c, + Unbox d, + Unbox e) => M.MVector MVector (a, b, c, d, e) where + {-# INLINE basicLength #-} + basicLength (MV_5 n_ _ _ _ _ _) = n_ + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice i_ m_ (MV_5 _ as bs cs ds es) + = MV_5 m_ (M.basicUnsafeSlice i_ m_ as) + (M.basicUnsafeSlice i_ m_ bs) + (M.basicUnsafeSlice i_ m_ cs) + (M.basicUnsafeSlice i_ m_ ds) + (M.basicUnsafeSlice i_ m_ es) + {-# INLINE basicOverlaps #-} + basicOverlaps (MV_5 _ as1 bs1 cs1 ds1 es1) (MV_5 _ as2 + bs2 + cs2 + ds2 + es2) + = M.basicOverlaps as1 as2 + || M.basicOverlaps bs1 bs2 + || M.basicOverlaps cs1 cs2 + || M.basicOverlaps ds1 ds2 + || M.basicOverlaps es1 es2 + {-# INLINE basicUnsafeNew #-} + basicUnsafeNew n_ + = do + as <- M.basicUnsafeNew n_ + bs <- M.basicUnsafeNew n_ + cs <- M.basicUnsafeNew n_ + ds <- M.basicUnsafeNew n_ + es <- M.basicUnsafeNew n_ + return $ MV_5 n_ as bs cs ds es + {-# INLINE basicInitialize #-} + basicInitialize (MV_5 _ as bs cs ds es) + = do + M.basicInitialize as + M.basicInitialize bs + M.basicInitialize cs + M.basicInitialize ds + M.basicInitialize es + {-# INLINE basicUnsafeReplicate #-} + basicUnsafeReplicate n_ (a, b, c, d, e) + = do + as <- M.basicUnsafeReplicate n_ a + bs <- M.basicUnsafeReplicate n_ b + cs <- M.basicUnsafeReplicate n_ c + ds <- M.basicUnsafeReplicate n_ d + es <- M.basicUnsafeReplicate n_ e + return $ MV_5 n_ as bs cs ds es + {-# INLINE basicUnsafeRead #-} + basicUnsafeRead (MV_5 _ as bs cs ds es) i_ + = do + a <- M.basicUnsafeRead as i_ + b <- M.basicUnsafeRead bs i_ + c <- M.basicUnsafeRead cs i_ + d <- M.basicUnsafeRead ds i_ + e <- M.basicUnsafeRead es i_ + return (a, b, c, d, e) + {-# INLINE basicUnsafeWrite #-} + basicUnsafeWrite (MV_5 _ as bs cs ds es) i_ (a, b, c, d, e) + = do + M.basicUnsafeWrite as i_ a + M.basicUnsafeWrite bs i_ b + M.basicUnsafeWrite cs i_ c + M.basicUnsafeWrite ds i_ d + M.basicUnsafeWrite es i_ e + {-# INLINE basicClear #-} + basicClear (MV_5 _ as bs cs ds es) + = do + M.basicClear as + M.basicClear bs + M.basicClear cs + M.basicClear ds + M.basicClear es + {-# INLINE basicSet #-} + basicSet (MV_5 _ as bs cs ds es) (a, b, c, d, e) + = do + M.basicSet as a + M.basicSet bs b + M.basicSet cs c + M.basicSet ds d + M.basicSet es e + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MV_5 _ as1 bs1 cs1 ds1 es1) (MV_5 _ as2 + bs2 + cs2 + ds2 + es2) + = do + M.basicUnsafeCopy as1 as2 + M.basicUnsafeCopy bs1 bs2 + M.basicUnsafeCopy cs1 cs2 + M.basicUnsafeCopy ds1 ds2 + M.basicUnsafeCopy es1 es2 + {-# INLINE basicUnsafeMove #-} + basicUnsafeMove (MV_5 _ as1 bs1 cs1 ds1 es1) (MV_5 _ as2 + bs2 + cs2 + ds2 + es2) + = do + M.basicUnsafeMove as1 as2 + M.basicUnsafeMove bs1 bs2 + M.basicUnsafeMove cs1 cs2 + M.basicUnsafeMove ds1 ds2 + M.basicUnsafeMove es1 es2 + {-# INLINE basicUnsafeGrow #-} + basicUnsafeGrow (MV_5 n_ as bs cs ds es) m_ + = do + as' <- M.basicUnsafeGrow as m_ + bs' <- M.basicUnsafeGrow bs m_ + cs' <- M.basicUnsafeGrow cs m_ + ds' <- M.basicUnsafeGrow ds m_ + es' <- M.basicUnsafeGrow es m_ + return $ MV_5 (m_+n_) as' bs' cs' ds' es' +instance (Unbox a, + Unbox b, + Unbox c, + Unbox d, + Unbox e) => G.Vector Vector (a, b, c, d, e) where + {-# INLINE basicUnsafeFreeze #-} + basicUnsafeFreeze (MV_5 n_ as bs cs ds es) + = do + as' <- G.basicUnsafeFreeze as + bs' <- G.basicUnsafeFreeze bs + cs' <- G.basicUnsafeFreeze cs + ds' <- G.basicUnsafeFreeze ds + es' <- G.basicUnsafeFreeze es + return $ V_5 n_ as' bs' cs' ds' es' + {-# INLINE basicUnsafeThaw #-} + basicUnsafeThaw (V_5 n_ as bs cs ds es) + = do + as' <- G.basicUnsafeThaw as + bs' <- G.basicUnsafeThaw bs + cs' <- G.basicUnsafeThaw cs + ds' <- G.basicUnsafeThaw ds + es' <- G.basicUnsafeThaw es + return $ MV_5 n_ as' bs' cs' ds' es' + {-# INLINE basicLength #-} + basicLength (V_5 n_ _ _ _ _ _) = n_ + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice i_ m_ (V_5 _ as bs cs ds es) + = V_5 m_ (G.basicUnsafeSlice i_ m_ as) + (G.basicUnsafeSlice i_ m_ bs) + (G.basicUnsafeSlice i_ m_ cs) + (G.basicUnsafeSlice i_ m_ ds) + (G.basicUnsafeSlice i_ m_ es) + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM (V_5 _ as bs cs ds es) i_ + = do + a <- G.basicUnsafeIndexM as i_ + b <- G.basicUnsafeIndexM bs i_ + c <- G.basicUnsafeIndexM cs i_ + d <- G.basicUnsafeIndexM ds i_ + e <- G.basicUnsafeIndexM es i_ + return (a, b, c, d, e) + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MV_5 _ as1 bs1 cs1 ds1 es1) (V_5 _ as2 + bs2 + cs2 + ds2 + es2) + = do + G.basicUnsafeCopy as1 as2 + G.basicUnsafeCopy bs1 bs2 + G.basicUnsafeCopy cs1 cs2 + G.basicUnsafeCopy ds1 ds2 + G.basicUnsafeCopy es1 es2 + {-# INLINE elemseq #-} + elemseq _ (a, b, c, d, e) + = G.elemseq (undefined :: Vector a) a + . G.elemseq (undefined :: Vector b) b + . G.elemseq (undefined :: Vector c) c + . G.elemseq (undefined :: Vector d) d + . G.elemseq (undefined :: Vector e) e +#endif +#ifdef DEFINE_MUTABLE +-- | /O(1)/ Zip 5 vectors +zip5 :: (Unbox a, + Unbox b, + Unbox c, + Unbox d, + Unbox e) => MVector s a -> + MVector s b -> + MVector s c -> + MVector s d -> + MVector s e -> MVector s (a, b, c, d, e) +{-# INLINE_FUSED zip5 #-} +zip5 as bs cs ds es = MV_5 len (unsafeSlice 0 len as) + (unsafeSlice 0 len bs) + (unsafeSlice 0 len cs) + (unsafeSlice 0 len ds) + (unsafeSlice 0 len es) + where + len = length as `delayed_min` + length bs `delayed_min` + length cs `delayed_min` + length ds `delayed_min` + length es +-- | /O(1)/ Unzip 5 vectors +unzip5 :: (Unbox a, + Unbox b, + Unbox c, + Unbox d, + Unbox e) => MVector s (a, b, c, d, e) -> (MVector s a, + MVector s b, + MVector s c, + MVector s d, + MVector s e) +{-# INLINE unzip5 #-} +unzip5 (MV_5 _ as bs cs ds es) = (as, bs, cs, ds, es) +#endif +#ifdef DEFINE_IMMUTABLE +-- | /O(1)/ Zip 5 vectors +zip5 :: (Unbox a, + Unbox b, + Unbox c, + Unbox d, + Unbox e) => Vector a -> + Vector b -> + Vector c -> + Vector d -> + Vector e -> Vector (a, b, c, d, e) +{-# INLINE_FUSED zip5 #-} +zip5 as bs cs ds es = V_5 len (unsafeSlice 0 len as) + (unsafeSlice 0 len bs) + (unsafeSlice 0 len cs) + (unsafeSlice 0 len ds) + (unsafeSlice 0 len es) + where + len = length as `delayed_min` + length bs `delayed_min` + length cs `delayed_min` + length ds `delayed_min` + length es +{-# RULES "stream/zip5 [Vector.Unboxed]" forall as bs cs ds es . + G.stream (zip5 as + bs + cs + ds + es) = Bundle.zipWith5 (, , , ,) (G.stream as) + (G.stream bs) + (G.stream cs) + (G.stream ds) + (G.stream es) #-} + +-- | /O(1)/ Unzip 5 vectors +unzip5 :: (Unbox a, + Unbox b, + Unbox c, + Unbox d, + Unbox e) => Vector (a, b, c, d, e) -> (Vector a, + Vector b, + Vector c, + Vector d, + Vector e) +{-# INLINE unzip5 #-} +unzip5 (V_5 _ as bs cs ds es) = (as, bs, cs, ds, es) +#endif +#ifdef DEFINE_INSTANCES +data instance MVector s (a, b, c, d, e, f) + = MV_6 {-# UNPACK #-} !Int !(MVector s a) + !(MVector s b) + !(MVector s c) + !(MVector s d) + !(MVector s e) + !(MVector s f) +data instance Vector (a, b, c, d, e, f) + = V_6 {-# UNPACK #-} !Int !(Vector a) + !(Vector b) + !(Vector c) + !(Vector d) + !(Vector e) + !(Vector f) +instance (Unbox a, + Unbox b, + Unbox c, + Unbox d, + Unbox e, + Unbox f) => Unbox (a, b, c, d, e, f) +instance (Unbox a, + Unbox b, + Unbox c, + Unbox d, + Unbox e, + Unbox f) => M.MVector MVector (a, b, c, d, e, f) where + {-# INLINE basicLength #-} + basicLength (MV_6 n_ _ _ _ _ _ _) = n_ + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice i_ m_ (MV_6 _ as bs cs ds es fs) + = MV_6 m_ (M.basicUnsafeSlice i_ m_ as) + (M.basicUnsafeSlice i_ m_ bs) + (M.basicUnsafeSlice i_ m_ cs) + (M.basicUnsafeSlice i_ m_ ds) + (M.basicUnsafeSlice i_ m_ es) + (M.basicUnsafeSlice i_ m_ fs) + {-# INLINE basicOverlaps #-} + basicOverlaps (MV_6 _ as1 bs1 cs1 ds1 es1 fs1) (MV_6 _ as2 + bs2 + cs2 + ds2 + es2 + fs2) + = M.basicOverlaps as1 as2 + || M.basicOverlaps bs1 bs2 + || M.basicOverlaps cs1 cs2 + || M.basicOverlaps ds1 ds2 + || M.basicOverlaps es1 es2 + || M.basicOverlaps fs1 fs2 + {-# INLINE basicUnsafeNew #-} + basicUnsafeNew n_ + = do + as <- M.basicUnsafeNew n_ + bs <- M.basicUnsafeNew n_ + cs <- M.basicUnsafeNew n_ + ds <- M.basicUnsafeNew n_ + es <- M.basicUnsafeNew n_ + fs <- M.basicUnsafeNew n_ + return $ MV_6 n_ as bs cs ds es fs + {-# INLINE basicInitialize #-} + basicInitialize (MV_6 _ as bs cs ds es fs) + = do + M.basicInitialize as + M.basicInitialize bs + M.basicInitialize cs + M.basicInitialize ds + M.basicInitialize es + M.basicInitialize fs + {-# INLINE basicUnsafeReplicate #-} + basicUnsafeReplicate n_ (a, b, c, d, e, f) + = do + as <- M.basicUnsafeReplicate n_ a + bs <- M.basicUnsafeReplicate n_ b + cs <- M.basicUnsafeReplicate n_ c + ds <- M.basicUnsafeReplicate n_ d + es <- M.basicUnsafeReplicate n_ e + fs <- M.basicUnsafeReplicate n_ f + return $ MV_6 n_ as bs cs ds es fs + {-# INLINE basicUnsafeRead #-} + basicUnsafeRead (MV_6 _ as bs cs ds es fs) i_ + = do + a <- M.basicUnsafeRead as i_ + b <- M.basicUnsafeRead bs i_ + c <- M.basicUnsafeRead cs i_ + d <- M.basicUnsafeRead ds i_ + e <- M.basicUnsafeRead es i_ + f <- M.basicUnsafeRead fs i_ + return (a, b, c, d, e, f) + {-# INLINE basicUnsafeWrite #-} + basicUnsafeWrite (MV_6 _ as bs cs ds es fs) i_ (a, b, c, d, e, f) + = do + M.basicUnsafeWrite as i_ a + M.basicUnsafeWrite bs i_ b + M.basicUnsafeWrite cs i_ c + M.basicUnsafeWrite ds i_ d + M.basicUnsafeWrite es i_ e + M.basicUnsafeWrite fs i_ f + {-# INLINE basicClear #-} + basicClear (MV_6 _ as bs cs ds es fs) + = do + M.basicClear as + M.basicClear bs + M.basicClear cs + M.basicClear ds + M.basicClear es + M.basicClear fs + {-# INLINE basicSet #-} + basicSet (MV_6 _ as bs cs ds es fs) (a, b, c, d, e, f) + = do + M.basicSet as a + M.basicSet bs b + M.basicSet cs c + M.basicSet ds d + M.basicSet es e + M.basicSet fs f + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MV_6 _ as1 bs1 cs1 ds1 es1 fs1) (MV_6 _ as2 + bs2 + cs2 + ds2 + es2 + fs2) + = do + M.basicUnsafeCopy as1 as2 + M.basicUnsafeCopy bs1 bs2 + M.basicUnsafeCopy cs1 cs2 + M.basicUnsafeCopy ds1 ds2 + M.basicUnsafeCopy es1 es2 + M.basicUnsafeCopy fs1 fs2 + {-# INLINE basicUnsafeMove #-} + basicUnsafeMove (MV_6 _ as1 bs1 cs1 ds1 es1 fs1) (MV_6 _ as2 + bs2 + cs2 + ds2 + es2 + fs2) + = do + M.basicUnsafeMove as1 as2 + M.basicUnsafeMove bs1 bs2 + M.basicUnsafeMove cs1 cs2 + M.basicUnsafeMove ds1 ds2 + M.basicUnsafeMove es1 es2 + M.basicUnsafeMove fs1 fs2 + {-# INLINE basicUnsafeGrow #-} + basicUnsafeGrow (MV_6 n_ as bs cs ds es fs) m_ + = do + as' <- M.basicUnsafeGrow as m_ + bs' <- M.basicUnsafeGrow bs m_ + cs' <- M.basicUnsafeGrow cs m_ + ds' <- M.basicUnsafeGrow ds m_ + es' <- M.basicUnsafeGrow es m_ + fs' <- M.basicUnsafeGrow fs m_ + return $ MV_6 (m_+n_) as' bs' cs' ds' es' fs' +instance (Unbox a, + Unbox b, + Unbox c, + Unbox d, + Unbox e, + Unbox f) => G.Vector Vector (a, b, c, d, e, f) where + {-# INLINE basicUnsafeFreeze #-} + basicUnsafeFreeze (MV_6 n_ as bs cs ds es fs) + = do + as' <- G.basicUnsafeFreeze as + bs' <- G.basicUnsafeFreeze bs + cs' <- G.basicUnsafeFreeze cs + ds' <- G.basicUnsafeFreeze ds + es' <- G.basicUnsafeFreeze es + fs' <- G.basicUnsafeFreeze fs + return $ V_6 n_ as' bs' cs' ds' es' fs' + {-# INLINE basicUnsafeThaw #-} + basicUnsafeThaw (V_6 n_ as bs cs ds es fs) + = do + as' <- G.basicUnsafeThaw as + bs' <- G.basicUnsafeThaw bs + cs' <- G.basicUnsafeThaw cs + ds' <- G.basicUnsafeThaw ds + es' <- G.basicUnsafeThaw es + fs' <- G.basicUnsafeThaw fs + return $ MV_6 n_ as' bs' cs' ds' es' fs' + {-# INLINE basicLength #-} + basicLength (V_6 n_ _ _ _ _ _ _) = n_ + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice i_ m_ (V_6 _ as bs cs ds es fs) + = V_6 m_ (G.basicUnsafeSlice i_ m_ as) + (G.basicUnsafeSlice i_ m_ bs) + (G.basicUnsafeSlice i_ m_ cs) + (G.basicUnsafeSlice i_ m_ ds) + (G.basicUnsafeSlice i_ m_ es) + (G.basicUnsafeSlice i_ m_ fs) + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM (V_6 _ as bs cs ds es fs) i_ + = do + a <- G.basicUnsafeIndexM as i_ + b <- G.basicUnsafeIndexM bs i_ + c <- G.basicUnsafeIndexM cs i_ + d <- G.basicUnsafeIndexM ds i_ + e <- G.basicUnsafeIndexM es i_ + f <- G.basicUnsafeIndexM fs i_ + return (a, b, c, d, e, f) + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MV_6 _ as1 bs1 cs1 ds1 es1 fs1) (V_6 _ as2 + bs2 + cs2 + ds2 + es2 + fs2) + = do + G.basicUnsafeCopy as1 as2 + G.basicUnsafeCopy bs1 bs2 + G.basicUnsafeCopy cs1 cs2 + G.basicUnsafeCopy ds1 ds2 + G.basicUnsafeCopy es1 es2 + G.basicUnsafeCopy fs1 fs2 + {-# INLINE elemseq #-} + elemseq _ (a, b, c, d, e, f) + = G.elemseq (undefined :: Vector a) a + . G.elemseq (undefined :: Vector b) b + . G.elemseq (undefined :: Vector c) c + . G.elemseq (undefined :: Vector d) d + . G.elemseq (undefined :: Vector e) e + . G.elemseq (undefined :: Vector f) f +#endif +#ifdef DEFINE_MUTABLE +-- | /O(1)/ Zip 6 vectors +zip6 :: (Unbox a, + Unbox b, + Unbox c, + Unbox d, + Unbox e, + Unbox f) => MVector s a -> + MVector s b -> + MVector s c -> + MVector s d -> + MVector s e -> + MVector s f -> MVector s (a, b, c, d, e, f) +{-# INLINE_FUSED zip6 #-} +zip6 as bs cs ds es fs = MV_6 len (unsafeSlice 0 len as) + (unsafeSlice 0 len bs) + (unsafeSlice 0 len cs) + (unsafeSlice 0 len ds) + (unsafeSlice 0 len es) + (unsafeSlice 0 len fs) + where + len = length as `delayed_min` + length bs `delayed_min` + length cs `delayed_min` + length ds `delayed_min` + length es `delayed_min` + length fs +-- | /O(1)/ Unzip 6 vectors +unzip6 :: (Unbox a, + Unbox b, + Unbox c, + Unbox d, + Unbox e, + Unbox f) => MVector s (a, b, c, d, e, f) -> (MVector s a, + MVector s b, + MVector s c, + MVector s d, + MVector s e, + MVector s f) +{-# INLINE unzip6 #-} +unzip6 (MV_6 _ as bs cs ds es fs) = (as, bs, cs, ds, es, fs) +#endif +#ifdef DEFINE_IMMUTABLE +-- | /O(1)/ Zip 6 vectors +zip6 :: (Unbox a, + Unbox b, + Unbox c, + Unbox d, + Unbox e, + Unbox f) => Vector a -> + Vector b -> + Vector c -> + Vector d -> + Vector e -> + Vector f -> Vector (a, b, c, d, e, f) +{-# INLINE_FUSED zip6 #-} +zip6 as bs cs ds es fs = V_6 len (unsafeSlice 0 len as) + (unsafeSlice 0 len bs) + (unsafeSlice 0 len cs) + (unsafeSlice 0 len ds) + (unsafeSlice 0 len es) + (unsafeSlice 0 len fs) + where + len = length as `delayed_min` + length bs `delayed_min` + length cs `delayed_min` + length ds `delayed_min` + length es `delayed_min` + length fs +{-# RULES "stream/zip6 [Vector.Unboxed]" forall as bs cs ds es fs . + G.stream (zip6 as + bs + cs + ds + es + fs) = Bundle.zipWith6 (, , , , ,) (G.stream as) + (G.stream bs) + (G.stream cs) + (G.stream ds) + (G.stream es) + (G.stream fs) #-} + +-- | /O(1)/ Unzip 6 vectors +unzip6 :: (Unbox a, + Unbox b, + Unbox c, + Unbox d, + Unbox e, + Unbox f) => Vector (a, b, c, d, e, f) -> (Vector a, + Vector b, + Vector c, + Vector d, + Vector e, + Vector f) +{-# INLINE unzip6 #-} +unzip6 (V_6 _ as bs cs ds es fs) = (as, bs, cs, ds, es, fs) +#endif diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/Boilerplater.hs b/third_party/bazel/rules_haskell/examples/vector/tests/Boilerplater.hs new file mode 100644 index 0000000000..5506209ebc --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/tests/Boilerplater.hs @@ -0,0 +1,27 @@ +module Boilerplater where + +import Test.Framework.Providers.QuickCheck2 + +import Language.Haskell.TH + + +testProperties :: [Name] -> Q Exp +testProperties nms = fmap ListE $ sequence [[| testProperty $(stringE prop_name) $(varE nm) |] + | nm <- nms + , Just prop_name <- [stripPrefix_maybe "prop_" (nameBase nm)]] + +-- This nice clean solution doesn't quite work since I need to use lexically-scoped type +-- variables, which aren't supported by Template Haskell. Argh! +-- testProperties :: Q [Dec] -> Q Exp +-- testProperties mdecs = do +-- decs <- mdecs +-- property_exprs <- sequence [[| testProperty "$prop_name" $(return $ VarE nm) |] +-- | FunD nm _clauses <- decs +-- , Just prop_name <- [stripPrefix_maybe "prop_" (nameBase nm)]] +-- return $ LetE decs (ListE property_exprs) + +stripPrefix_maybe :: String -> String -> Maybe String +stripPrefix_maybe prefix what + | what_start == prefix = Just what_end + | otherwise = Nothing + where (what_start, what_end) = splitAt (length prefix) what diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/LICENSE b/third_party/bazel/rules_haskell/examples/vector/tests/LICENSE new file mode 100644 index 0000000000..43c0cee637 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/tests/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2009, Max Bolingbroke and Roman Leshchinskiy +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +- Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. + +- Neither name of the University nor the names of its contributors may be +used to endorse or promote products derived from this software without +specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF +GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH +DAMAGE. + diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/Main.hs b/third_party/bazel/rules_haskell/examples/vector/tests/Main.hs new file mode 100644 index 0000000000..6642888323 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/tests/Main.hs @@ -0,0 +1,15 @@ +module Main (main) where + +import qualified Tests.Vector +import qualified Tests.Vector.UnitTests +import qualified Tests.Bundle +import qualified Tests.Move + +import Test.Framework (defaultMain) + +main :: IO () +main = defaultMain $ Tests.Bundle.tests + ++ Tests.Vector.tests + ++ Tests.Vector.UnitTests.tests + ++ Tests.Move.tests + diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/Setup.hs b/third_party/bazel/rules_haskell/examples/vector/tests/Setup.hs new file mode 100644 index 0000000000..200a2e51d0 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/tests/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple +main = defaultMain + diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Bundle.hs b/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Bundle.hs new file mode 100644 index 0000000000..09368a1999 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Bundle.hs @@ -0,0 +1,163 @@ +module Tests.Bundle ( tests ) where + +import Boilerplater +import Utilities + +import qualified Data.Vector.Fusion.Bundle as S + +import Test.QuickCheck + +import Test.Framework +import Test.Framework.Providers.QuickCheck2 + +import Text.Show.Functions () +import Data.List (foldl', foldl1', unfoldr, find, findIndex) +import System.Random (Random) + +#define COMMON_CONTEXT(a) \ + VANILLA_CONTEXT(a) + +#define VANILLA_CONTEXT(a) \ + Eq a, Show a, Arbitrary a, CoArbitrary a, TestData a, Model a ~ a, EqTest a ~ Property + +testSanity :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test] +testSanity _ = [ + testProperty "fromList.toList == id" prop_fromList_toList, + testProperty "toList.fromList == id" prop_toList_fromList + ] + where + prop_fromList_toList :: P (S.Bundle v a -> S.Bundle v a) + = (S.fromList . S.toList) `eq` id + prop_toList_fromList :: P ([a] -> [a]) + = (S.toList . (S.fromList :: [a] -> S.Bundle v a)) `eq` id + +testPolymorphicFunctions :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test] +testPolymorphicFunctions _ = $(testProperties [ + 'prop_eq, + + 'prop_length, 'prop_null, + + 'prop_empty, 'prop_singleton, 'prop_replicate, + 'prop_cons, 'prop_snoc, 'prop_append, + + 'prop_head, 'prop_last, 'prop_index, + + 'prop_extract, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop, + + 'prop_map, 'prop_zipWith, 'prop_zipWith3, + 'prop_filter, 'prop_takeWhile, 'prop_dropWhile, + + 'prop_elem, 'prop_notElem, + 'prop_find, 'prop_findIndex, + + 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1', + 'prop_foldr, 'prop_foldr1, + + 'prop_prescanl, 'prop_prescanl', + 'prop_postscanl, 'prop_postscanl', + 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1', + + 'prop_concatMap, + 'prop_unfoldr + ]) + where + -- Prelude + prop_eq :: P (S.Bundle v a -> S.Bundle v a -> Bool) = (==) `eq` (==) + + prop_length :: P (S.Bundle v a -> Int) = S.length `eq` length + prop_null :: P (S.Bundle v a -> Bool) = S.null `eq` null + prop_empty :: P (S.Bundle v a) = S.empty `eq` [] + prop_singleton :: P (a -> S.Bundle v a) = S.singleton `eq` singleton + prop_replicate :: P (Int -> a -> S.Bundle v a) + = (\n _ -> n < 1000) ===> S.replicate `eq` replicate + prop_cons :: P (a -> S.Bundle v a -> S.Bundle v a) = S.cons `eq` (:) + prop_snoc :: P (S.Bundle v a -> a -> S.Bundle v a) = S.snoc `eq` snoc + prop_append :: P (S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = (S.++) `eq` (++) + + prop_head :: P (S.Bundle v a -> a) = not . S.null ===> S.head `eq` head + prop_last :: P (S.Bundle v a -> a) = not . S.null ===> S.last `eq` last + prop_index = \xs -> + not (S.null xs) ==> + forAll (choose (0, S.length xs-1)) $ \i -> + unP prop xs i + where + prop :: P (S.Bundle v a -> Int -> a) = (S.!!) `eq` (!!) + + prop_extract = \xs -> + forAll (choose (0, S.length xs)) $ \i -> + forAll (choose (0, S.length xs - i)) $ \n -> + unP prop i n xs + where + prop :: P (Int -> Int -> S.Bundle v a -> S.Bundle v a) = S.slice `eq` slice + + prop_tail :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.tail `eq` tail + prop_init :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.init `eq` init + prop_take :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.take `eq` take + prop_drop :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.drop `eq` drop + + prop_map :: P ((a -> a) -> S.Bundle v a -> S.Bundle v a) = S.map `eq` map + prop_zipWith :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = S.zipWith `eq` zipWith + prop_zipWith3 :: P ((a -> a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a) + = S.zipWith3 `eq` zipWith3 + + prop_filter :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.filter `eq` filter + prop_takeWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.takeWhile `eq` takeWhile + prop_dropWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.dropWhile `eq` dropWhile + + prop_elem :: P (a -> S.Bundle v a -> Bool) = S.elem `eq` elem + prop_notElem :: P (a -> S.Bundle v a -> Bool) = S.notElem `eq` notElem + prop_find :: P ((a -> Bool) -> S.Bundle v a -> Maybe a) = S.find `eq` find + prop_findIndex :: P ((a -> Bool) -> S.Bundle v a -> Maybe Int) + = S.findIndex `eq` findIndex + + prop_foldl :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl `eq` foldl + prop_foldl1 :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===> + S.foldl1 `eq` foldl1 + prop_foldl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl' `eq` foldl' + prop_foldl1' :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===> + S.foldl1' `eq` foldl1' + prop_foldr :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldr `eq` foldr + prop_foldr1 :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===> + S.foldr1 `eq` foldr1 + + prop_prescanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) + = S.prescanl `eq` prescanl + prop_prescanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) + = S.prescanl' `eq` prescanl + prop_postscanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) + = S.postscanl `eq` postscanl + prop_postscanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) + = S.postscanl' `eq` postscanl + prop_scanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) + = S.scanl `eq` scanl + prop_scanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) + = S.scanl' `eq` scanl + prop_scanl1 :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===> + S.scanl1 `eq` scanl1 + prop_scanl1' :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===> + S.scanl1' `eq` scanl1 + + prop_concatMap = forAll arbitrary $ \xs -> + forAll (sized (\n -> resize (n `div` S.length xs) arbitrary)) $ \f -> unP prop f xs + where + prop :: P ((a -> S.Bundle v a) -> S.Bundle v a -> S.Bundle v a) = S.concatMap `eq` concatMap + + limitUnfolds f (theirs, ours) | ours >= 0 + , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1)) + | otherwise = Nothing + prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> S.Bundle v a) + = (\n f a -> S.unfoldr (limitUnfolds f) (a, n)) + `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) + +testBoolFunctions :: forall v. S.Bundle v Bool -> [Test] +testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or ]) + where + prop_and :: P (S.Bundle v Bool -> Bool) = S.and `eq` and + prop_or :: P (S.Bundle v Bool -> Bool) = S.or `eq` or + +testBundleFunctions = testSanity (undefined :: S.Bundle v Int) + ++ testPolymorphicFunctions (undefined :: S.Bundle v Int) + ++ testBoolFunctions (undefined :: S.Bundle v Bool) + +tests = [ testGroup "Data.Vector.Fusion.Bundle" testBundleFunctions ] + diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Move.hs b/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Move.hs new file mode 100644 index 0000000000..60ea8d3346 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Move.hs @@ -0,0 +1,49 @@ +module Tests.Move (tests) where + +import Test.QuickCheck +import Test.Framework.Providers.QuickCheck2 +import Test.QuickCheck.Property (Property(..)) + +import Utilities () + +import Control.Monad (replicateM) +import Control.Monad.ST (runST) +import Data.List (sort,permutations) + +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Generic.Mutable as M + +import qualified Data.Vector as V +import qualified Data.Vector.Primitive as P +import qualified Data.Vector.Storable as S +import qualified Data.Vector.Unboxed as U + +basicMove :: G.Vector v a => v a -> Int -> Int -> Int -> v a +basicMove v dstOff srcOff len + | len > 0 = G.modify (\ mv -> G.copy (M.slice dstOff len mv) (G.slice srcOff len v)) v + | otherwise = v + +testMove :: (G.Vector v a, Show (v a), Eq (v a)) => v a -> Property +testMove v = G.length v > 0 ==> (MkProperty $ do + dstOff <- choose (0, G.length v - 1) + srcOff <- choose (0, G.length v - 1) + len <- choose (1, G.length v - max dstOff srcOff) + expected <- return $ basicMove v dstOff srcOff len + actual <- return $ G.modify (\ mv -> M.move (M.slice dstOff len mv) (M.slice srcOff len mv)) v + unProperty $ counterexample ("Move: " ++ show (v, dstOff, srcOff, len)) (expected == actual)) + +checkPermutations :: Int -> Bool +checkPermutations n = runST $ do + vec <- U.thaw (U.fromList [1..n]) + res <- replicateM (product [1..n]) $ M.nextPermutation vec >> U.freeze vec >>= return . U.toList + return $! ([1..n] : res) == sort (permutations [1..n]) ++ [[n,n-1..1]] + +testPermutations :: Bool +testPermutations = all checkPermutations [1..7] + +tests = + [testProperty "Data.Vector.Mutable (Move)" (testMove :: V.Vector Int -> Property), + testProperty "Data.Vector.Primitive.Mutable (Move)" (testMove :: P.Vector Int -> Property), + testProperty "Data.Vector.Unboxed.Mutable (Move)" (testMove :: U.Vector Int -> Property), + testProperty "Data.Vector.Storable.Mutable (Move)" (testMove :: S.Vector Int -> Property), + testProperty "Data.Vector.Generic.Mutable (nextPermutation)" testPermutations] diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector.hs b/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector.hs new file mode 100644 index 0000000000..46569d9095 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector.hs @@ -0,0 +1,706 @@ +{-# LANGUAGE ConstraintKinds #-} +module Tests.Vector (tests) where + +import Boilerplater +import Utilities as Util + +import Data.Functor.Identity +import qualified Data.Traversable as T (Traversable(..)) +import Data.Foldable (Foldable(foldMap)) + +import qualified Data.Vector.Generic as V +import qualified Data.Vector +import qualified Data.Vector.Primitive +import qualified Data.Vector.Storable +import qualified Data.Vector.Unboxed +import qualified Data.Vector.Fusion.Bundle as S + +import Test.QuickCheck + +import Test.Framework +import Test.Framework.Providers.QuickCheck2 + +import Text.Show.Functions () +import Data.List +import Data.Monoid +import qualified Control.Applicative as Applicative +import System.Random (Random) + +import Data.Functor.Identity +import Control.Monad.Trans.Writer + +import Control.Monad.Zip + +type CommonContext a v = (VanillaContext a, VectorContext a v) +type VanillaContext a = ( Eq a , Show a, Arbitrary a, CoArbitrary a + , TestData a, Model a ~ a, EqTest a ~ Property) +type VectorContext a v = ( Eq (v a), Show (v a), Arbitrary (v a), CoArbitrary (v a) + , TestData (v a), Model (v a) ~ [a], EqTest (v a) ~ Property, V.Vector v a) + +-- TODO: implement Vector equivalents of list functions for some of the commented out properties + +-- TODO: test and implement some of these other Prelude functions: +-- mapM * +-- mapM_ * +-- sequence +-- sequence_ +-- sum * +-- product * +-- scanl * +-- scanl1 * +-- scanr * +-- scanr1 * +-- lookup * +-- lines +-- words +-- unlines +-- unwords +-- NB: this is an exhaustive list of all Prelude list functions that make sense for vectors. +-- Ones with *s are the most plausible candidates. + +-- TODO: add tests for the other extra functions +-- IVector exports still needing tests: +-- copy, +-- slice, +-- (//), update, bpermute, +-- prescanl, prescanl', +-- new, +-- unsafeSlice, unsafeIndex, +-- vlength, vnew + +-- TODO: test non-IVector stuff? + +#if !MIN_VERSION_base(4,7,0) +instance Foldable ((,) a) where + foldMap f (_, b) = f b + +instance T.Traversable ((,) a) where + traverse f (a, b) = fmap ((,) a) $ f b +#endif + +testSanity :: forall a v. (CommonContext a v) => v a -> [Test] +testSanity _ = [ + testProperty "fromList.toList == id" prop_fromList_toList, + testProperty "toList.fromList == id" prop_toList_fromList, + testProperty "unstream.stream == id" prop_unstream_stream, + testProperty "stream.unstream == id" prop_stream_unstream + ] + where + prop_fromList_toList (v :: v a) = (V.fromList . V.toList) v == v + prop_toList_fromList (l :: [a]) = ((V.toList :: v a -> [a]) . V.fromList) l == l + prop_unstream_stream (v :: v a) = (V.unstream . V.stream) v == v + prop_stream_unstream (s :: S.Bundle v a) = ((V.stream :: v a -> S.Bundle v a) . V.unstream) s == s + +testPolymorphicFunctions :: forall a v. (CommonContext a v, VectorContext Int v) => v a -> [Test] +testPolymorphicFunctions _ = $(testProperties [ + 'prop_eq, + + -- Length information + 'prop_length, 'prop_null, + + -- Indexing (FIXME) + 'prop_index, 'prop_safeIndex, 'prop_head, 'prop_last, + 'prop_unsafeIndex, 'prop_unsafeHead, 'prop_unsafeLast, + + -- Monadic indexing (FIXME) + {- 'prop_indexM, 'prop_headM, 'prop_lastM, + 'prop_unsafeIndexM, 'prop_unsafeHeadM, 'prop_unsafeLastM, -} + + -- Subvectors (FIXME) + 'prop_slice, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop, + 'prop_splitAt, + {- 'prop_unsafeSlice, 'prop_unsafeInit, 'prop_unsafeTail, + 'prop_unsafeTake, 'prop_unsafeDrop, -} + + -- Initialisation (FIXME) + 'prop_empty, 'prop_singleton, 'prop_replicate, + 'prop_generate, 'prop_iterateN, 'prop_iterateNM, + + -- Monadic initialisation (FIXME) + 'prop_createT, + {- 'prop_replicateM, 'prop_generateM, 'prop_create, -} + + -- Unfolding + 'prop_unfoldr, 'prop_unfoldrN, 'prop_unfoldrM, 'prop_unfoldrNM, + 'prop_constructN, 'prop_constructrN, + + -- Enumeration? (FIXME?) + + -- Concatenation (FIXME) + 'prop_cons, 'prop_snoc, 'prop_append, + 'prop_concat, + + -- Restricting memory usage + 'prop_force, + + + -- Bulk updates (FIXME) + 'prop_upd, + {- 'prop_update, 'prop_update_, + 'prop_unsafeUpd, 'prop_unsafeUpdate, 'prop_unsafeUpdate_, -} + + -- Accumulations (FIXME) + 'prop_accum, + {- 'prop_accumulate, 'prop_accumulate_, + 'prop_unsafeAccum, 'prop_unsafeAccumulate, 'prop_unsafeAccumulate_, -} + + -- Permutations + 'prop_reverse, 'prop_backpermute, + {- 'prop_unsafeBackpermute, -} + + -- Elementwise indexing + {- 'prop_indexed, -} + + -- Mapping + 'prop_map, 'prop_imap, 'prop_concatMap, + + -- Monadic mapping + {- 'prop_mapM, 'prop_mapM_, 'prop_forM, 'prop_forM_, -} + 'prop_imapM, 'prop_imapM_, + + -- Zipping + 'prop_zipWith, 'prop_zipWith3, {- ... -} + 'prop_izipWith, 'prop_izipWith3, {- ... -} + 'prop_izipWithM, 'prop_izipWithM_, + {- 'prop_zip, ... -} + + -- Monadic zipping + {- 'prop_zipWithM, 'prop_zipWithM_, -} + + -- Unzipping + {- 'prop_unzip, ... -} + + -- Filtering + 'prop_filter, 'prop_ifilter, {- prop_filterM, -} + 'prop_uniq, + 'prop_mapMaybe, 'prop_imapMaybe, + 'prop_takeWhile, 'prop_dropWhile, + + -- Paritioning + 'prop_partition, {- 'prop_unstablePartition, -} + 'prop_span, 'prop_break, + + -- Searching + 'prop_elem, 'prop_notElem, + 'prop_find, 'prop_findIndex, 'prop_findIndices, + 'prop_elemIndex, 'prop_elemIndices, + + -- Folding + 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1', + 'prop_foldr, 'prop_foldr1, 'prop_foldr', 'prop_foldr1', + 'prop_ifoldl, 'prop_ifoldl', 'prop_ifoldr, 'prop_ifoldr', + 'prop_ifoldM, 'prop_ifoldM', 'prop_ifoldM_, 'prop_ifoldM'_, + + -- Specialised folds + 'prop_all, 'prop_any, + {- 'prop_maximumBy, 'prop_minimumBy, + 'prop_maxIndexBy, 'prop_minIndexBy, -} + + -- Monadic folds + {- ... -} + + -- Monadic sequencing + {- ... -} + + -- Scans + 'prop_prescanl, 'prop_prescanl', + 'prop_postscanl, 'prop_postscanl', + 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1', + 'prop_iscanl, 'prop_iscanl', + + 'prop_prescanr, 'prop_prescanr', + 'prop_postscanr, 'prop_postscanr', + 'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1', + 'prop_iscanr, 'prop_iscanr' + ]) + where + -- Prelude + prop_eq :: P (v a -> v a -> Bool) = (==) `eq` (==) + + prop_length :: P (v a -> Int) = V.length `eq` length + prop_null :: P (v a -> Bool) = V.null `eq` null + + prop_empty :: P (v a) = V.empty `eq` [] + prop_singleton :: P (a -> v a) = V.singleton `eq` singleton + prop_replicate :: P (Int -> a -> v a) + = (\n _ -> n < 1000) ===> V.replicate `eq` replicate + prop_cons :: P (a -> v a -> v a) = V.cons `eq` (:) + prop_snoc :: P (v a -> a -> v a) = V.snoc `eq` snoc + prop_append :: P (v a -> v a -> v a) = (V.++) `eq` (++) + prop_concat :: P ([v a] -> v a) = V.concat `eq` concat + prop_force :: P (v a -> v a) = V.force `eq` id + prop_generate :: P (Int -> (Int -> a) -> v a) + = (\n _ -> n < 1000) ===> V.generate `eq` Util.generate + prop_iterateN :: P (Int -> (a -> a) -> a -> v a) + = (\n _ _ -> n < 1000) ===> V.iterateN `eq` (\n f -> take n . iterate f) + prop_iterateNM :: P (Int -> (a -> Writer [Int] a) -> a -> Writer [Int] (v a)) + = (\n _ _ -> n < 1000) ===> V.iterateNM `eq` Util.iterateNM + prop_createT :: P ((a, v a) -> (a, v a)) + prop_createT = (\v -> V.createT (T.mapM V.thaw v)) `eq` id + + prop_head :: P (v a -> a) = not . V.null ===> V.head `eq` head + prop_last :: P (v a -> a) = not . V.null ===> V.last `eq` last + prop_index = \xs -> + not (V.null xs) ==> + forAll (choose (0, V.length xs-1)) $ \i -> + unP prop xs i + where + prop :: P (v a -> Int -> a) = (V.!) `eq` (!!) + prop_safeIndex :: P (v a -> Int -> Maybe a) = (V.!?) `eq` fn + where + fn xs i = case drop i xs of + x:_ | i >= 0 -> Just x + _ -> Nothing + prop_unsafeHead :: P (v a -> a) = not . V.null ===> V.unsafeHead `eq` head + prop_unsafeLast :: P (v a -> a) = not . V.null ===> V.unsafeLast `eq` last + prop_unsafeIndex = \xs -> + not (V.null xs) ==> + forAll (choose (0, V.length xs-1)) $ \i -> + unP prop xs i + where + prop :: P (v a -> Int -> a) = V.unsafeIndex `eq` (!!) + + prop_slice = \xs -> + forAll (choose (0, V.length xs)) $ \i -> + forAll (choose (0, V.length xs - i)) $ \n -> + unP prop i n xs + where + prop :: P (Int -> Int -> v a -> v a) = V.slice `eq` slice + + prop_tail :: P (v a -> v a) = not . V.null ===> V.tail `eq` tail + prop_init :: P (v a -> v a) = not . V.null ===> V.init `eq` init + prop_take :: P (Int -> v a -> v a) = V.take `eq` take + prop_drop :: P (Int -> v a -> v a) = V.drop `eq` drop + prop_splitAt :: P (Int -> v a -> (v a, v a)) = V.splitAt `eq` splitAt + + prop_accum = \f xs -> + forAll (index_value_pairs (V.length xs)) $ \ps -> + unP prop f xs ps + where + prop :: P ((a -> a -> a) -> v a -> [(Int,a)] -> v a) + = V.accum `eq` accum + + prop_upd = \xs -> + forAll (index_value_pairs (V.length xs)) $ \ps -> + unP prop xs ps + where + prop :: P (v a -> [(Int,a)] -> v a) = (V.//) `eq` (//) + + prop_backpermute = \xs -> + forAll (indices (V.length xs)) $ \is -> + unP prop xs (V.fromList is) + where + prop :: P (v a -> v Int -> v a) = V.backpermute `eq` backpermute + + prop_reverse :: P (v a -> v a) = V.reverse `eq` reverse + + prop_map :: P ((a -> a) -> v a -> v a) = V.map `eq` map + prop_zipWith :: P ((a -> a -> a) -> v a -> v a -> v a) = V.zipWith `eq` zipWith + prop_zipWith3 :: P ((a -> a -> a -> a) -> v a -> v a -> v a -> v a) + = V.zipWith3 `eq` zipWith3 + prop_imap :: P ((Int -> a -> a) -> v a -> v a) = V.imap `eq` imap + prop_imapM :: P ((Int -> a -> Identity a) -> v a -> Identity (v a)) + = V.imapM `eq` imapM + prop_imapM_ :: P ((Int -> a -> Writer [a] ()) -> v a -> Writer [a] ()) + = V.imapM_ `eq` imapM_ + prop_izipWith :: P ((Int -> a -> a -> a) -> v a -> v a -> v a) = V.izipWith `eq` izipWith + prop_izipWithM :: P ((Int -> a -> a -> Identity a) -> v a -> v a -> Identity (v a)) + = V.izipWithM `eq` izipWithM + prop_izipWithM_ :: P ((Int -> a -> a -> Writer [a] ()) -> v a -> v a -> Writer [a] ()) + = V.izipWithM_ `eq` izipWithM_ + prop_izipWith3 :: P ((Int -> a -> a -> a -> a) -> v a -> v a -> v a -> v a) + = V.izipWith3 `eq` izipWith3 + + prop_filter :: P ((a -> Bool) -> v a -> v a) = V.filter `eq` filter + prop_ifilter :: P ((Int -> a -> Bool) -> v a -> v a) = V.ifilter `eq` ifilter + prop_mapMaybe :: P ((a -> Maybe a) -> v a -> v a) = V.mapMaybe `eq` mapMaybe + prop_imapMaybe :: P ((Int -> a -> Maybe a) -> v a -> v a) = V.imapMaybe `eq` imapMaybe + prop_takeWhile :: P ((a -> Bool) -> v a -> v a) = V.takeWhile `eq` takeWhile + prop_dropWhile :: P ((a -> Bool) -> v a -> v a) = V.dropWhile `eq` dropWhile + prop_partition :: P ((a -> Bool) -> v a -> (v a, v a)) + = V.partition `eq` partition + prop_span :: P ((a -> Bool) -> v a -> (v a, v a)) = V.span `eq` span + prop_break :: P ((a -> Bool) -> v a -> (v a, v a)) = V.break `eq` break + + prop_elem :: P (a -> v a -> Bool) = V.elem `eq` elem + prop_notElem :: P (a -> v a -> Bool) = V.notElem `eq` notElem + prop_find :: P ((a -> Bool) -> v a -> Maybe a) = V.find `eq` find + prop_findIndex :: P ((a -> Bool) -> v a -> Maybe Int) + = V.findIndex `eq` findIndex + prop_findIndices :: P ((a -> Bool) -> v a -> v Int) + = V.findIndices `eq` findIndices + prop_elemIndex :: P (a -> v a -> Maybe Int) = V.elemIndex `eq` elemIndex + prop_elemIndices :: P (a -> v a -> v Int) = V.elemIndices `eq` elemIndices + + prop_foldl :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl `eq` foldl + prop_foldl1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> + V.foldl1 `eq` foldl1 + prop_foldl' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl' `eq` foldl' + prop_foldl1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> + V.foldl1' `eq` foldl1' + prop_foldr :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr `eq` foldr + prop_foldr1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> + V.foldr1 `eq` foldr1 + prop_foldr' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr' `eq` foldr + prop_foldr1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> + V.foldr1' `eq` foldr1 + prop_ifoldl :: P ((a -> Int -> a -> a) -> a -> v a -> a) + = V.ifoldl `eq` ifoldl + prop_ifoldl' :: P ((a -> Int -> a -> a) -> a -> v a -> a) + = V.ifoldl' `eq` ifoldl + prop_ifoldr :: P ((Int -> a -> a -> a) -> a -> v a -> a) + = V.ifoldr `eq` ifoldr + prop_ifoldr' :: P ((Int -> a -> a -> a) -> a -> v a -> a) + = V.ifoldr' `eq` ifoldr + prop_ifoldM :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a) + = V.ifoldM `eq` ifoldM + prop_ifoldM' :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a) + = V.ifoldM' `eq` ifoldM + prop_ifoldM_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ()) + = V.ifoldM_ `eq` ifoldM_ + prop_ifoldM'_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ()) + = V.ifoldM'_ `eq` ifoldM_ + + prop_all :: P ((a -> Bool) -> v a -> Bool) = V.all `eq` all + prop_any :: P ((a -> Bool) -> v a -> Bool) = V.any `eq` any + + prop_prescanl :: P ((a -> a -> a) -> a -> v a -> v a) + = V.prescanl `eq` prescanl + prop_prescanl' :: P ((a -> a -> a) -> a -> v a -> v a) + = V.prescanl' `eq` prescanl + prop_postscanl :: P ((a -> a -> a) -> a -> v a -> v a) + = V.postscanl `eq` postscanl + prop_postscanl' :: P ((a -> a -> a) -> a -> v a -> v a) + = V.postscanl' `eq` postscanl + prop_scanl :: P ((a -> a -> a) -> a -> v a -> v a) + = V.scanl `eq` scanl + prop_scanl' :: P ((a -> a -> a) -> a -> v a -> v a) + = V.scanl' `eq` scanl + prop_scanl1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> + V.scanl1 `eq` scanl1 + prop_scanl1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> + V.scanl1' `eq` scanl1 + prop_iscanl :: P ((Int -> a -> a -> a) -> a -> v a -> v a) + = V.iscanl `eq` iscanl + prop_iscanl' :: P ((Int -> a -> a -> a) -> a -> v a -> v a) + = V.iscanl' `eq` iscanl + + prop_prescanr :: P ((a -> a -> a) -> a -> v a -> v a) + = V.prescanr `eq` prescanr + prop_prescanr' :: P ((a -> a -> a) -> a -> v a -> v a) + = V.prescanr' `eq` prescanr + prop_postscanr :: P ((a -> a -> a) -> a -> v a -> v a) + = V.postscanr `eq` postscanr + prop_postscanr' :: P ((a -> a -> a) -> a -> v a -> v a) + = V.postscanr' `eq` postscanr + prop_scanr :: P ((a -> a -> a) -> a -> v a -> v a) + = V.scanr `eq` scanr + prop_scanr' :: P ((a -> a -> a) -> a -> v a -> v a) + = V.scanr' `eq` scanr + prop_iscanr :: P ((Int -> a -> a -> a) -> a -> v a -> v a) + = V.iscanr `eq` iscanr + prop_iscanr' :: P ((Int -> a -> a -> a) -> a -> v a -> v a) + = V.iscanr' `eq` iscanr + prop_scanr1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> + V.scanr1 `eq` scanr1 + prop_scanr1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> + V.scanr1' `eq` scanr1 + + prop_concatMap = forAll arbitrary $ \xs -> + forAll (sized (\n -> resize (n `div` V.length xs) arbitrary)) $ \f -> unP prop f xs + where + prop :: P ((a -> v a) -> v a -> v a) = V.concatMap `eq` concatMap + + prop_uniq :: P (v a -> v a) + = V.uniq `eq` (map head . group) + --prop_span = (V.span :: (a -> Bool) -> v a -> (v a, v a)) `eq2` span + --prop_break = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break + --prop_splitAt = (V.splitAt :: Int -> v a -> (v a, v a)) `eq2` splitAt + --prop_all = (V.all :: (a -> Bool) -> v a -> Bool) `eq2` all + --prop_any = (V.any :: (a -> Bool) -> v a -> Bool) `eq2` any + + -- Data.List + --prop_findIndices = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int) + --prop_isPrefixOf = V.isPrefixOf `eq2` (isPrefixOf :: v a -> v a -> Bool) + --prop_elemIndex = V.elemIndex `eq2` (elemIndex :: a -> v a -> Maybe Int) + --prop_elemIndices = V.elemIndices `eq2` (elemIndices :: a -> v a -> v Int) + -- + --prop_mapAccumL = eq3 + -- (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B)) + -- ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W])) + -- + --prop_mapAccumR = eq3 + -- (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B -> (X, B)) + -- ( mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W])) + + -- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This + -- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed. + limitUnfolds f (theirs, ours) + | ours > 0 + , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1)) + | otherwise = Nothing + limitUnfoldsM f (theirs, ours) + | ours > 0 = do r <- f theirs + return $ (\(a,b) -> (a,(b,ours - 1))) `fmap` r + | otherwise = return Nothing + + + prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a) + = (\n f a -> V.unfoldr (limitUnfolds f) (a, n)) + `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) + prop_unfoldrN :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a) + = V.unfoldrN `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) + prop_unfoldrM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a)) + = (\n f a -> V.unfoldrM (limitUnfoldsM f) (a,n)) + `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n)) + prop_unfoldrNM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a)) + = V.unfoldrNM `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n)) + + prop_constructN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f + where + prop :: P (Int -> (v a -> a) -> v a) = V.constructN `eq` constructN [] + + constructN xs 0 _ = xs + constructN xs n f = constructN (xs ++ [f xs]) (n-1) f + + prop_constructrN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f + where + prop :: P (Int -> (v a -> a) -> v a) = V.constructrN `eq` constructrN [] + + constructrN xs 0 _ = xs + constructrN xs n f = constructrN (f xs : xs) (n-1) f + +testTuplyFunctions:: forall a v. (CommonContext a v, VectorContext (a, a) v, VectorContext (a, a, a) v) => v a -> [Test] +testTuplyFunctions _ = $(testProperties [ 'prop_zip, 'prop_zip3 + , 'prop_unzip, 'prop_unzip3 + , 'prop_mzip, 'prop_munzip + ]) + where + prop_zip :: P (v a -> v a -> v (a, a)) = V.zip `eq` zip + prop_zip3 :: P (v a -> v a -> v a -> v (a, a, a)) = V.zip3 `eq` zip3 + prop_unzip :: P (v (a, a) -> (v a, v a)) = V.unzip `eq` unzip + prop_unzip3 :: P (v (a, a, a) -> (v a, v a, v a)) = V.unzip3 `eq` unzip3 + prop_mzip :: P (Data.Vector.Vector a -> Data.Vector.Vector a -> Data.Vector.Vector (a, a)) + = mzip `eq` zip + prop_munzip :: P (Data.Vector.Vector (a, a) -> (Data.Vector.Vector a, Data.Vector.Vector a)) + = munzip `eq` unzip + +testOrdFunctions :: forall a v. (CommonContext a v, Ord a, Ord (v a)) => v a -> [Test] +testOrdFunctions _ = $(testProperties + ['prop_compare, + 'prop_maximum, 'prop_minimum, + 'prop_minIndex, 'prop_maxIndex ]) + where + prop_compare :: P (v a -> v a -> Ordering) = compare `eq` compare + prop_maximum :: P (v a -> a) = not . V.null ===> V.maximum `eq` maximum + prop_minimum :: P (v a -> a) = not . V.null ===> V.minimum `eq` minimum + prop_minIndex :: P (v a -> Int) = not . V.null ===> V.minIndex `eq` minIndex + prop_maxIndex :: P (v a -> Int) = not . V.null ===> V.maxIndex `eq` maxIndex + +testEnumFunctions :: forall a v. (CommonContext a v, Enum a, Ord a, Num a, Random a) => v a -> [Test] +testEnumFunctions _ = $(testProperties + [ 'prop_enumFromN, 'prop_enumFromThenN, + 'prop_enumFromTo, 'prop_enumFromThenTo]) + where + prop_enumFromN :: P (a -> Int -> v a) + = (\_ n -> n < 1000) + ===> V.enumFromN `eq` (\x n -> take n $ scanl (+) x $ repeat 1) + + prop_enumFromThenN :: P (a -> a -> Int -> v a) + = (\_ _ n -> n < 1000) + ===> V.enumFromStepN `eq` (\x y n -> take n $ scanl (+) x $ repeat y) + + prop_enumFromTo = \m -> + forAll (choose (-2,100)) $ \n -> + unP prop m (m+n) + where + prop :: P (a -> a -> v a) = V.enumFromTo `eq` enumFromTo + + prop_enumFromThenTo = \i j -> + j /= i ==> + forAll (choose (ks i j)) $ \k -> + unP prop i j k + where + prop :: P (a -> a -> a -> v a) = V.enumFromThenTo `eq` enumFromThenTo + + ks i j | j < i = (i-d*100, i+d*2) + | otherwise = (i-d*2, i+d*100) + where + d = abs (j-i) + +testMonoidFunctions :: forall a v. (CommonContext a v, Monoid (v a)) => v a -> [Test] +testMonoidFunctions _ = $(testProperties + [ 'prop_mempty, 'prop_mappend, 'prop_mconcat ]) + where + prop_mempty :: P (v a) = mempty `eq` mempty + prop_mappend :: P (v a -> v a -> v a) = mappend `eq` mappend + prop_mconcat :: P ([v a] -> v a) = mconcat `eq` mconcat + +testFunctorFunctions :: forall a v. (CommonContext a v, Functor v) => v a -> [Test] +testFunctorFunctions _ = $(testProperties + [ 'prop_fmap ]) + where + prop_fmap :: P ((a -> a) -> v a -> v a) = fmap `eq` fmap + +testMonadFunctions :: forall a v. (CommonContext a v, Monad v) => v a -> [Test] +testMonadFunctions _ = $(testProperties + [ 'prop_return, 'prop_bind ]) + where + prop_return :: P (a -> v a) = return `eq` return + prop_bind :: P (v a -> (a -> v a) -> v a) = (>>=) `eq` (>>=) + +testApplicativeFunctions :: forall a v. (CommonContext a v, V.Vector v (a -> a), Applicative.Applicative v) => v a -> [Test] +testApplicativeFunctions _ = $(testProperties + [ 'prop_applicative_pure, 'prop_applicative_appl ]) + where + prop_applicative_pure :: P (a -> v a) + = Applicative.pure `eq` Applicative.pure + prop_applicative_appl :: [a -> a] -> P (v a -> v a) + = \fs -> (Applicative.<*>) (V.fromList fs) `eq` (Applicative.<*>) fs + +testAlternativeFunctions :: forall a v. (CommonContext a v, Applicative.Alternative v) => v a -> [Test] +testAlternativeFunctions _ = $(testProperties + [ 'prop_alternative_empty, 'prop_alternative_or ]) + where + prop_alternative_empty :: P (v a) = Applicative.empty `eq` Applicative.empty + prop_alternative_or :: P (v a -> v a -> v a) + = (Applicative.<|>) `eq` (Applicative.<|>) + +testBoolFunctions :: forall v. (CommonContext Bool v) => v Bool -> [Test] +testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or]) + where + prop_and :: P (v Bool -> Bool) = V.and `eq` and + prop_or :: P (v Bool -> Bool) = V.or `eq` or + +testNumFunctions :: forall a v. (CommonContext a v, Num a) => v a -> [Test] +testNumFunctions _ = $(testProperties ['prop_sum, 'prop_product]) + where + prop_sum :: P (v a -> a) = V.sum `eq` sum + prop_product :: P (v a -> a) = V.product `eq` product + +testNestedVectorFunctions :: forall a v. (CommonContext a v) => v a -> [Test] +testNestedVectorFunctions _ = $(testProperties []) + where + -- Prelude + --prop_concat = (V.concat :: [v a] -> v a) `eq1` concat + + -- Data.List + --prop_transpose = V.transpose `eq1` (transpose :: [v a] -> [v a]) + --prop_group = V.group `eq1` (group :: v a -> [v a]) + --prop_inits = V.inits `eq1` (inits :: v a -> [v a]) + --prop_tails = V.tails `eq1` (tails :: v a -> [v a]) + +testGeneralBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a) => Data.Vector.Vector a -> [Test] +testGeneralBoxedVector dummy = concatMap ($ dummy) [ + testSanity, + testPolymorphicFunctions, + testOrdFunctions, + testTuplyFunctions, + testNestedVectorFunctions, + testMonoidFunctions, + testFunctorFunctions, + testMonadFunctions, + testApplicativeFunctions, + testAlternativeFunctions + ] + +testBoolBoxedVector dummy = concatMap ($ dummy) + [ + testGeneralBoxedVector + , testBoolFunctions + ] + +testNumericBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a, Num a, Enum a, Random a) => Data.Vector.Vector a -> [Test] +testNumericBoxedVector dummy = concatMap ($ dummy) + [ + testGeneralBoxedVector + , testNumFunctions + , testEnumFunctions + ] + + +testGeneralPrimitiveVector :: forall a. (CommonContext a Data.Vector.Primitive.Vector, Data.Vector.Primitive.Prim a, Ord a) => Data.Vector.Primitive.Vector a -> [Test] +testGeneralPrimitiveVector dummy = concatMap ($ dummy) [ + testSanity, + testPolymorphicFunctions, + testOrdFunctions, + testMonoidFunctions + ] + +testNumericPrimitiveVector :: forall a. (CommonContext a Data.Vector.Primitive.Vector, Data.Vector.Primitive.Prim a, Ord a, Num a, Enum a, Random a) => Data.Vector.Primitive.Vector a -> [Test] +testNumericPrimitiveVector dummy = concatMap ($ dummy) + [ + testGeneralPrimitiveVector + , testNumFunctions + , testEnumFunctions + ] + + +testGeneralStorableVector :: forall a. (CommonContext a Data.Vector.Storable.Vector, Data.Vector.Storable.Storable a, Ord a) => Data.Vector.Storable.Vector a -> [Test] +testGeneralStorableVector dummy = concatMap ($ dummy) [ + testSanity, + testPolymorphicFunctions, + testOrdFunctions, + testMonoidFunctions + ] + +testNumericStorableVector :: forall a. (CommonContext a Data.Vector.Storable.Vector, Data.Vector.Storable.Storable a, Ord a, Num a, Enum a, Random a) => Data.Vector.Storable.Vector a -> [Test] +testNumericStorableVector dummy = concatMap ($ dummy) + [ + testGeneralStorableVector + , testNumFunctions + , testEnumFunctions + ] + + +testGeneralUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a) => Data.Vector.Unboxed.Vector a -> [Test] +testGeneralUnboxedVector dummy = concatMap ($ dummy) [ + testSanity, + testPolymorphicFunctions, + testOrdFunctions, + testMonoidFunctions + ] + +testUnitUnboxedVector dummy = concatMap ($ dummy) + [ + testGeneralUnboxedVector + ] + +testBoolUnboxedVector dummy = concatMap ($ dummy) + [ + testGeneralUnboxedVector + , testBoolFunctions + ] + +testNumericUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Num a, Enum a, Random a) => Data.Vector.Unboxed.Vector a -> [Test] +testNumericUnboxedVector dummy = concatMap ($ dummy) + [ + testGeneralUnboxedVector + , testNumFunctions + , testEnumFunctions + ] + +testTupleUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a) => Data.Vector.Unboxed.Vector a -> [Test] +testTupleUnboxedVector dummy = concatMap ($ dummy) + [ + testGeneralUnboxedVector + ] + +tests = [ + testGroup "Data.Vector.Vector (Bool)" (testBoolBoxedVector (undefined :: Data.Vector.Vector Bool)), + testGroup "Data.Vector.Vector (Int)" (testNumericBoxedVector (undefined :: Data.Vector.Vector Int)), + + testGroup "Data.Vector.Primitive.Vector (Int)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Int)), + testGroup "Data.Vector.Primitive.Vector (Double)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Double)), + + testGroup "Data.Vector.Storable.Vector (Int)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Int)), + testGroup "Data.Vector.Storable.Vector (Double)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Double)), + + testGroup "Data.Vector.Unboxed.Vector ()" (testUnitUnboxedVector (undefined :: Data.Vector.Unboxed.Vector ())), + testGroup "Data.Vector.Unboxed.Vector (Bool)" (testBoolUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Bool)), + testGroup "Data.Vector.Unboxed.Vector (Int)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int)), + testGroup "Data.Vector.Unboxed.Vector (Double)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double)), + testGroup "Data.Vector.Unboxed.Vector (Int,Bool)" (testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int,Bool))), + testGroup "Data.Vector.Unboxed.Vector (Int,Bool,Int)" (testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int,Bool,Int))) + + ] diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector/UnitTests.hs b/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector/UnitTests.hs new file mode 100644 index 0000000000..5827640d84 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector/UnitTests.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Tests.Vector.UnitTests (tests) where + +import Control.Applicative as Applicative +import qualified Data.Vector.Storable as Storable +import Foreign.Ptr +import Foreign.Storable +import Text.Printf + +import Test.Framework +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (Assertion, assertBool) + +newtype Aligned a = Aligned { getAligned :: a } + +instance (Storable a) => Storable (Aligned a) where + sizeOf _ = sizeOf (undefined :: a) + alignment _ = 128 + peek ptr = Aligned Applicative.<$> peek (castPtr ptr) + poke ptr = poke (castPtr ptr) . getAligned + +checkAddressAlignment :: forall a. (Storable a) => Storable.Vector a -> Assertion +checkAddressAlignment xs = Storable.unsafeWith xs $ \ptr -> do + let ptr' = ptrToWordPtr ptr + msg = printf "Expected pointer with alignment %d but got 0x%08x" (toInteger align) (toInteger ptr') + align :: WordPtr + align = fromIntegral $ alignment dummy + assertBool msg $ (ptr' `mod` align) == 0 + where + dummy :: a + dummy = undefined + +tests :: [Test] +tests = + [ testGroup "Data.Vector.Storable.Vector Alignment" + [ testCase "Aligned Double" $ + checkAddressAlignment alignedDoubleVec + , testCase "Aligned Int" $ + checkAddressAlignment alignedIntVec + ] + ] + +alignedDoubleVec :: Storable.Vector (Aligned Double) +alignedDoubleVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5] + +alignedIntVec :: Storable.Vector (Aligned Int) +alignedIntVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5] diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/Utilities.hs b/third_party/bazel/rules_haskell/examples/vector/tests/Utilities.hs new file mode 100644 index 0000000000..86a4f2c324 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/tests/Utilities.hs @@ -0,0 +1,350 @@ +{-# LANGUAGE FlexibleInstances, GADTs #-} +module Utilities where + +import Test.QuickCheck + +import qualified Data.Vector as DV +import qualified Data.Vector.Generic as DVG +import qualified Data.Vector.Primitive as DVP +import qualified Data.Vector.Storable as DVS +import qualified Data.Vector.Unboxed as DVU +import qualified Data.Vector.Fusion.Bundle as S + +import Control.Monad (foldM, foldM_, zipWithM, zipWithM_) +import Control.Monad.Trans.Writer +import Data.Function (on) +import Data.Functor.Identity +import Data.List ( sortBy ) +import Data.Monoid +import Data.Maybe (catMaybes) + +instance Show a => Show (S.Bundle v a) where + show s = "Data.Vector.Fusion.Bundle.fromList " ++ show (S.toList s) + + +instance Arbitrary a => Arbitrary (DV.Vector a) where + arbitrary = fmap DV.fromList arbitrary + +instance CoArbitrary a => CoArbitrary (DV.Vector a) where + coarbitrary = coarbitrary . DV.toList + +instance (Arbitrary a, DVP.Prim a) => Arbitrary (DVP.Vector a) where + arbitrary = fmap DVP.fromList arbitrary + +instance (CoArbitrary a, DVP.Prim a) => CoArbitrary (DVP.Vector a) where + coarbitrary = coarbitrary . DVP.toList + +instance (Arbitrary a, DVS.Storable a) => Arbitrary (DVS.Vector a) where + arbitrary = fmap DVS.fromList arbitrary + +instance (CoArbitrary a, DVS.Storable a) => CoArbitrary (DVS.Vector a) where + coarbitrary = coarbitrary . DVS.toList + +instance (Arbitrary a, DVU.Unbox a) => Arbitrary (DVU.Vector a) where + arbitrary = fmap DVU.fromList arbitrary + +instance (CoArbitrary a, DVU.Unbox a) => CoArbitrary (DVU.Vector a) where + coarbitrary = coarbitrary . DVU.toList + +instance Arbitrary a => Arbitrary (S.Bundle v a) where + arbitrary = fmap S.fromList arbitrary + +instance CoArbitrary a => CoArbitrary (S.Bundle v a) where + coarbitrary = coarbitrary . S.toList + +instance (Arbitrary a, Arbitrary b) => Arbitrary (Writer a b) where + arbitrary = do b <- arbitrary + a <- arbitrary + return $ writer (b,a) + +instance CoArbitrary a => CoArbitrary (Writer a ()) where + coarbitrary = coarbitrary . runWriter + +class (Testable (EqTest a), Conclusion (EqTest a)) => TestData a where + type Model a + model :: a -> Model a + unmodel :: Model a -> a + + type EqTest a + equal :: a -> a -> EqTest a + +instance Eq a => TestData (S.Bundle v a) where + type Model (S.Bundle v a) = [a] + model = S.toList + unmodel = S.fromList + + type EqTest (S.Bundle v a) = Property + equal x y = property (x == y) + +instance Eq a => TestData (DV.Vector a) where + type Model (DV.Vector a) = [a] + model = DV.toList + unmodel = DV.fromList + + type EqTest (DV.Vector a) = Property + equal x y = property (x == y) + +instance (Eq a, DVP.Prim a) => TestData (DVP.Vector a) where + type Model (DVP.Vector a) = [a] + model = DVP.toList + unmodel = DVP.fromList + + type EqTest (DVP.Vector a) = Property + equal x y = property (x == y) + +instance (Eq a, DVS.Storable a) => TestData (DVS.Vector a) where + type Model (DVS.Vector a) = [a] + model = DVS.toList + unmodel = DVS.fromList + + type EqTest (DVS.Vector a) = Property + equal x y = property (x == y) + +instance (Eq a, DVU.Unbox a) => TestData (DVU.Vector a) where + type Model (DVU.Vector a) = [a] + model = DVU.toList + unmodel = DVU.fromList + + type EqTest (DVU.Vector a) = Property + equal x y = property (x == y) + +#define id_TestData(ty) \ +instance TestData ty where { \ + type Model ty = ty; \ + model = id; \ + unmodel = id; \ + \ + type EqTest ty = Property; \ + equal x y = property (x == y) } + +id_TestData(()) +id_TestData(Bool) +id_TestData(Int) +id_TestData(Float) +id_TestData(Double) +id_TestData(Ordering) + +-- Functorish models +-- All of these need UndecidableInstances although they are actually well founded. Oh well. +instance (Eq a, TestData a) => TestData (Maybe a) where + type Model (Maybe a) = Maybe (Model a) + model = fmap model + unmodel = fmap unmodel + + type EqTest (Maybe a) = Property + equal x y = property (x == y) + +instance (Eq a, TestData a) => TestData [a] where + type Model [a] = [Model a] + model = fmap model + unmodel = fmap unmodel + + type EqTest [a] = Property + equal x y = property (x == y) + +instance (Eq a, TestData a) => TestData (Identity a) where + type Model (Identity a) = Identity (Model a) + model = fmap model + unmodel = fmap unmodel + + type EqTest (Identity a) = Property + equal = (property .) . on (==) runIdentity + +instance (Eq a, TestData a, Eq b, TestData b, Monoid a) => TestData (Writer a b) where + type Model (Writer a b) = Writer (Model a) (Model b) + model = mapWriter model + unmodel = mapWriter unmodel + + type EqTest (Writer a b) = Property + equal = (property .) . on (==) runWriter + +instance (Eq a, Eq b, TestData a, TestData b) => TestData (a,b) where + type Model (a,b) = (Model a, Model b) + model (a,b) = (model a, model b) + unmodel (a,b) = (unmodel a, unmodel b) + + type EqTest (a,b) = Property + equal x y = property (x == y) + +instance (Eq a, Eq b, Eq c, TestData a, TestData b, TestData c) => TestData (a,b,c) where + type Model (a,b,c) = (Model a, Model b, Model c) + model (a,b,c) = (model a, model b, model c) + unmodel (a,b,c) = (unmodel a, unmodel b, unmodel c) + + type EqTest (a,b,c) = Property + equal x y = property (x == y) + +instance (Arbitrary a, Show a, TestData a, TestData b) => TestData (a -> b) where + type Model (a -> b) = Model a -> Model b + model f = model . f . unmodel + unmodel f = unmodel . f . model + + type EqTest (a -> b) = a -> EqTest b + equal f g x = equal (f x) (g x) + +newtype P a = P { unP :: EqTest a } + +instance TestData a => Testable (P a) where + property (P a) = property a + +infix 4 `eq` +eq :: TestData a => a -> Model a -> P a +eq x y = P (equal x (unmodel y)) + +class Conclusion p where + type Predicate p + + predicate :: Predicate p -> p -> p + +instance Conclusion Property where + type Predicate Property = Bool + + predicate = (==>) + +instance Conclusion p => Conclusion (a -> p) where + type Predicate (a -> p) = a -> Predicate p + + predicate f p = \x -> predicate (f x) (p x) + +infixr 0 ===> +(===>) :: TestData a => Predicate (EqTest a) -> P a -> P a +p ===> P a = P (predicate p a) + +notNull2 _ xs = not $ DVG.null xs +notNullS2 _ s = not $ S.null s + +-- Generators +index_value_pairs :: Arbitrary a => Int -> Gen [(Int,a)] +index_value_pairs 0 = return [] +index_value_pairs m = sized $ \n -> + do + len <- choose (0,n) + is <- sequence [choose (0,m-1) | i <- [1..len]] + xs <- vector len + return $ zip is xs + +indices :: Int -> Gen [Int] +indices 0 = return [] +indices m = sized $ \n -> + do + len <- choose (0,n) + sequence [choose (0,m-1) | i <- [1..len]] + + +-- Additional list functions +singleton x = [x] +snoc xs x = xs ++ [x] +generate n f = [f i | i <- [0 .. n-1]] +slice i n xs = take n (drop i xs) +backpermute xs is = map (xs!!) is +prescanl f z = init . scanl f z +postscanl f z = tail . scanl f z +prescanr f z = tail . scanr f z +postscanr f z = init . scanr f z + +accum :: (a -> b -> a) -> [a] -> [(Int,b)] -> [a] +accum f xs ps = go xs ps' 0 + where + ps' = sortBy (\p q -> compare (fst p) (fst q)) ps + + go (x:xs) ((i,y) : ps) j + | i == j = go (f x y : xs) ps j + go (x:xs) ps j = x : go xs ps (j+1) + go [] _ _ = [] + +(//) :: [a] -> [(Int, a)] -> [a] +xs // ps = go xs ps' 0 + where + ps' = sortBy (\p q -> compare (fst p) (fst q)) ps + + go (x:xs) ((i,y) : ps) j + | i == j = go (y:xs) ps j + go (x:xs) ps j = x : go xs ps (j+1) + go [] _ _ = [] + + +withIndexFirst m f = m (uncurry f) . zip [0..] + +imap :: (Int -> a -> a) -> [a] -> [a] +imap = withIndexFirst map + +imapM :: Monad m => (Int -> a -> m a) -> [a] -> m [a] +imapM = withIndexFirst mapM + +imapM_ :: Monad m => (Int -> a -> m b) -> [a] -> m () +imapM_ = withIndexFirst mapM_ + +izipWith :: (Int -> a -> a -> a) -> [a] -> [a] -> [a] +izipWith = withIndexFirst zipWith + +izipWithM :: Monad m => (Int -> a -> a -> m a) -> [a] -> [a] -> m [a] +izipWithM = withIndexFirst zipWithM + +izipWithM_ :: Monad m => (Int -> a -> a -> m b) -> [a] -> [a] -> m () +izipWithM_ = withIndexFirst zipWithM_ + +izipWith3 :: (Int -> a -> a -> a -> a) -> [a] -> [a] -> [a] -> [a] +izipWith3 = withIndexFirst zipWith3 + +ifilter :: (Int -> a -> Bool) -> [a] -> [a] +ifilter f = map snd . withIndexFirst filter f + +mapMaybe :: (a -> Maybe b) -> [a] -> [b] +mapMaybe f = catMaybes . map f + +imapMaybe :: (Int -> a -> Maybe b) -> [a] -> [b] +imapMaybe f = catMaybes . withIndexFirst map f + +indexedLeftFold fld f z = fld (uncurry . f) z . zip [0..] + +ifoldl :: (a -> Int -> a -> a) -> a -> [a] -> a +ifoldl = indexedLeftFold foldl + +iscanl :: (Int -> a -> b -> a) -> a -> [b] -> [a] +iscanl f z = scanl (\a (i, b) -> f i a b) z . zip [0..] + +iscanr :: (Int -> a -> b -> b) -> b -> [a] -> [b] +iscanr f z = scanr (uncurry f) z . zip [0..] + +ifoldr :: (Int -> a -> b -> b) -> b -> [a] -> b +ifoldr f z = foldr (uncurry f) z . zip [0..] + +ifoldM :: Monad m => (a -> Int -> a -> m a) -> a -> [a] -> m a +ifoldM = indexedLeftFold foldM + +ifoldM_ :: Monad m => (b -> Int -> a -> m b) -> b -> [a] -> m () +ifoldM_ = indexedLeftFold foldM_ + +minIndex :: Ord a => [a] -> Int +minIndex = fst . foldr1 imin . zip [0..] + where + imin (i,x) (j,y) | x <= y = (i,x) + | otherwise = (j,y) + +maxIndex :: Ord a => [a] -> Int +maxIndex = fst . foldr1 imax . zip [0..] + where + imax (i,x) (j,y) | x >= y = (i,x) + | otherwise = (j,y) + +iterateNM :: Monad m => Int -> (a -> m a) -> a -> m [a] +iterateNM n f x + | n <= 0 = return [] + | n == 1 = return [x] + | otherwise = do x' <- f x + xs <- iterateNM (n-1) f x' + return (x : xs) + +unfoldrM :: Monad m => (b -> m (Maybe (a,b))) -> b -> m [a] +unfoldrM step b0 = do + r <- step b0 + case r of + Nothing -> return [] + Just (a,b) -> do as <- unfoldrM step b + return (a : as) + + +limitUnfolds f (theirs, ours) + | ours >= 0 + , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1)) + | otherwise = Nothing diff --git a/third_party/bazel/rules_haskell/examples/vector/vector.cabal b/third_party/bazel/rules_haskell/examples/vector/vector.cabal new file mode 100644 index 0000000000..013d522b2c --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/vector.cabal @@ -0,0 +1,251 @@ +Name: vector +Version: 0.12.0.1 +x-revision: 2 +-- don't forget to update the changelog file! +License: BSD3 +License-File: LICENSE +Author: Roman Leshchinskiy <rl@cse.unsw.edu.au> +Maintainer: Haskell Libraries Team <libraries@haskell.org> +Copyright: (c) Roman Leshchinskiy 2008-2012 +Homepage: https://github.com/haskell/vector +Bug-Reports: https://github.com/haskell/vector/issues +Category: Data, Data Structures +Synopsis: Efficient Arrays +Description: + . + An efficient implementation of Int-indexed arrays (both mutable + and immutable), with a powerful loop optimisation framework . + . + It is structured as follows: + . + ["Data.Vector"] Boxed vectors of arbitrary types. + . + ["Data.Vector.Unboxed"] Unboxed vectors with an adaptive + representation based on data type families. + . + ["Data.Vector.Storable"] Unboxed vectors of 'Storable' types. + . + ["Data.Vector.Primitive"] Unboxed vectors of primitive types as + defined by the @primitive@ package. "Data.Vector.Unboxed" is more + flexible at no performance cost. + . + ["Data.Vector.Generic"] Generic interface to the vector types. + . + There is also a (draft) tutorial on common uses of vector. + . + * <http://haskell.org/haskellwiki/Numeric_Haskell:_A_Vector_Tutorial> + +Tested-With: + GHC == 7.4.2, + GHC == 7.6.3, + GHC == 7.8.4, + GHC == 7.10.3, + GHC == 8.0.1 + +Cabal-Version: >=1.10 +Build-Type: Simple + +Extra-Source-Files: + changelog + README.md + tests/LICENSE + tests/Setup.hs + tests/Main.hs + benchmarks/vector-benchmarks.cabal + benchmarks/LICENSE + benchmarks/Setup.hs + benchmarks/Main.hs + benchmarks/Algo/AwShCC.hs + benchmarks/Algo/HybCC.hs + benchmarks/Algo/Leaffix.hs + benchmarks/Algo/ListRank.hs + benchmarks/Algo/Quickhull.hs + benchmarks/Algo/Rootfix.hs + benchmarks/Algo/Spectral.hs + benchmarks/Algo/Tridiag.hs + benchmarks/TestData/Graph.hs + benchmarks/TestData/ParenTree.hs + benchmarks/TestData/Random.hs + changelog + internal/GenUnboxTuple.hs + internal/unbox-tuple-instances + +Flag BoundsChecks + Description: Enable bounds checking + Default: True + Manual: True + +Flag UnsafeChecks + Description: Enable bounds checking in unsafe operations at the cost of a + significant performance penalty + Default: False + Manual: True + +Flag InternalChecks + Description: Enable internal consistency checks at the cost of a + significant performance penalty + Default: False + Manual: True + +Flag Wall + Description: Enable all -Wall warnings + Default: False + Manual: True + +Library + Default-Language: Haskell2010 + Other-Extensions: + BangPatterns + CPP + DeriveDataTypeable + ExistentialQuantification + FlexibleContexts + FlexibleInstances + GADTs + KindSignatures + MagicHash + MultiParamTypeClasses + Rank2Types + ScopedTypeVariables + StandaloneDeriving + TypeFamilies + + Exposed-Modules: + Data.Vector.Internal.Check + + Data.Vector.Fusion.Util + Data.Vector.Fusion.Stream.Monadic + Data.Vector.Fusion.Bundle.Size + Data.Vector.Fusion.Bundle.Monadic + Data.Vector.Fusion.Bundle + + Data.Vector.Generic.Mutable.Base + Data.Vector.Generic.Mutable + Data.Vector.Generic.Base + Data.Vector.Generic.New + Data.Vector.Generic + + Data.Vector.Primitive.Mutable + Data.Vector.Primitive + + Data.Vector.Storable.Internal + Data.Vector.Storable.Mutable + Data.Vector.Storable + + Data.Vector.Unboxed.Base + Data.Vector.Unboxed.Mutable + Data.Vector.Unboxed + + Data.Vector.Mutable + Data.Vector + + Include-Dirs: + include, internal + + Install-Includes: + vector.h + + Build-Depends: base >= 4.5 && < 4.12 + , primitive >= 0.5.0.1 && < 0.7 + , ghc-prim >= 0.2 && < 0.6 + , deepseq >= 1.1 && < 1.5 + if !impl(ghc > 8.0) + Build-Depends: semigroups >= 0.18 && < 0.19 + + Ghc-Options: -O2 -Wall + + if !flag(Wall) + Ghc-Options: -fno-warn-orphans + + if impl(ghc >= 8.0) && impl(ghc < 8.1) + Ghc-Options: -Wno-redundant-constraints + + if flag(BoundsChecks) + cpp-options: -DVECTOR_BOUNDS_CHECKS + + if flag(UnsafeChecks) + cpp-options: -DVECTOR_UNSAFE_CHECKS + + if flag(InternalChecks) + cpp-options: -DVECTOR_INTERNAL_CHECKS + +source-repository head + type: git + location: https://github.com/haskell/vector.git + + + +test-suite vector-tests-O0 + Default-Language: Haskell2010 + type: exitcode-stdio-1.0 + Main-Is: Main.hs + + other-modules: Boilerplater + Tests.Bundle + Tests.Move + Tests.Vector + Tests.Vector.UnitTests + Utilities + + hs-source-dirs: tests + Build-Depends: base >= 4.5 && < 5, template-haskell, vector, + random, + QuickCheck >= 2.9 && < 2.10 , HUnit, test-framework, + test-framework-hunit, test-framework-quickcheck2, + transformers >= 0.2.0.0 + + default-extensions: CPP, + ScopedTypeVariables, + PatternGuards, + MultiParamTypeClasses, + FlexibleContexts, + Rank2Types, + TypeSynonymInstances, + TypeFamilies, + TemplateHaskell + + Ghc-Options: -O0 + Ghc-Options: -Wall + + if !flag(Wall) + Ghc-Options: -fno-warn-orphans -fno-warn-missing-signatures + if impl(ghc >= 8.0) && impl( ghc < 8.1) + Ghc-Options: -Wno-redundant-constraints + + +test-suite vector-tests-O2 + Default-Language: Haskell2010 + type: exitcode-stdio-1.0 + Main-Is: Main.hs + + other-modules: Boilerplater + Tests.Bundle + Tests.Move + Tests.Vector + Tests.Vector.UnitTests + Utilities + + hs-source-dirs: tests + Build-Depends: base >= 4.5 && < 5, template-haskell, vector, + random, + QuickCheck >= 2.9 && < 2.10 , HUnit, test-framework, + test-framework-hunit, test-framework-quickcheck2, + transformers >= 0.2.0.0 + + default-extensions: CPP, + ScopedTypeVariables, + PatternGuards, + MultiParamTypeClasses, + FlexibleContexts, + Rank2Types, + TypeSynonymInstances, + TypeFamilies, + TemplateHaskell + + Ghc-Options: -O2 -Wall + + if !flag(Wall) + Ghc-Options: -fno-warn-orphans -fno-warn-missing-signatures + if impl(ghc >= 8.0) && impl(ghc < 8.1) + Ghc-Options: -Wno-redundant-constraints + |