diff options
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/vector')
54 files changed, 0 insertions, 19183 deletions
diff --git a/third_party/bazel/rules_haskell/examples/vector/BUILD.bazel b/third_party/bazel/rules_haskell/examples/vector/BUILD.bazel deleted file mode 100644 index 7c00806efe..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/BUILD.bazel +++ /dev/null @@ -1,38 +0,0 @@ -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 deleted file mode 100644 index 21b61960ca..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector.hs +++ /dev/null @@ -1,1719 +0,0 @@ -{-# 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 deleted file mode 100644 index 6b6b6236d7..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle.hs +++ /dev/null @@ -1,655 +0,0 @@ -{-# 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 deleted file mode 100644 index 46f4a165f8..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Monadic.hs +++ /dev/null @@ -1,1106 +0,0 @@ -{-# 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 deleted file mode 100644 index e90cf37320..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Size.hs +++ /dev/null @@ -1,121 +0,0 @@ --- | --- 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 deleted file mode 100644 index cca002ca6f..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Stream/Monadic.hs +++ /dev/null @@ -1,1639 +0,0 @@ -{-# 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 deleted file mode 100644 index 855bf5ddd4..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Util.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# 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 deleted file mode 100644 index 066c07fd3d..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic.hs +++ /dev/null @@ -1,2206 +0,0 @@ -{-# 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 deleted file mode 100644 index a760329c59..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Base.hs +++ /dev/null @@ -1,140 +0,0 @@ -{-# 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 deleted file mode 100644 index 89bebf3607..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable.hs +++ /dev/null @@ -1,1034 +0,0 @@ -{-# 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 deleted file mode 100644 index ce931eec9b..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable/Base.hs +++ /dev/null @@ -1,145 +0,0 @@ -{-# 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 deleted file mode 100644 index e94ce19e16..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/New.hs +++ /dev/null @@ -1,178 +0,0 @@ -{-# 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 deleted file mode 100644 index 4a4ef80fe1..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Internal/Check.hs +++ /dev/null @@ -1,152 +0,0 @@ -{-# 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 deleted file mode 100644 index ba701afb6a..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Mutable.hs +++ /dev/null @@ -1,416 +0,0 @@ -{-# 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 deleted file mode 100644 index ba18f9ba95..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Primitive.hs +++ /dev/null @@ -1,1393 +0,0 @@ -{-# 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 deleted file mode 100644 index 33aca812e2..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Primitive/Mutable.hs +++ /dev/null @@ -1,366 +0,0 @@ -{-# 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 deleted file mode 100644 index 30c9a4615c..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable.hs +++ /dev/null @@ -1,1489 +0,0 @@ -{-# 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 deleted file mode 100644 index 69a46d8421..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Internal.hs +++ /dev/null @@ -1,33 +0,0 @@ --- | --- 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 deleted file mode 100644 index 29eb2fbfa3..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Mutable.hs +++ /dev/null @@ -1,543 +0,0 @@ -{-# 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 deleted file mode 100644 index 72dd109fb3..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed.hs +++ /dev/null @@ -1,1488 +0,0 @@ -{-# 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 deleted file mode 100644 index a88795c5b4..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Base.hs +++ /dev/null @@ -1,408 +0,0 @@ -{-# 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 deleted file mode 100644 index cb82acea8f..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Mutable.hs +++ /dev/null @@ -1,307 +0,0 @@ -{-# 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 deleted file mode 100644 index cafa68efb3..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -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 deleted file mode 100644 index 079dbd0b6b..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/README.md +++ /dev/null @@ -1,6 +0,0 @@ -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 deleted file mode 100644 index 200a2e51d0..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/Setup.hs +++ /dev/null @@ -1,3 +0,0 @@ -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 deleted file mode 100644 index 404e289fae..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/AwShCC.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# 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 deleted file mode 100644 index 876d08f75b..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/HybCC.hs +++ /dev/null @@ -1,42 +0,0 @@ -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 deleted file mode 100644 index 40ec517556..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Leaffix.hs +++ /dev/null @@ -1,16 +0,0 @@ -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 deleted file mode 100644 index 933bd8eb2e..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/ListRank.hs +++ /dev/null @@ -1,21 +0,0 @@ -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 deleted file mode 100644 index 694bea3097..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Quickhull.hs +++ /dev/null @@ -1,32 +0,0 @@ -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 deleted file mode 100644 index 1b112a801a..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Rootfix.hs +++ /dev/null @@ -1,15 +0,0 @@ -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 deleted file mode 100644 index 811c58269e..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Spectral.hs +++ /dev/null @@ -1,21 +0,0 @@ -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 deleted file mode 100644 index 7668deace1..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Tridiag.hs +++ /dev/null @@ -1,16 +0,0 @@ -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 deleted file mode 100644 index fc213a6ffb..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/benchmarks/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -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 deleted file mode 100644 index 65bd297a75..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Main.hs +++ /dev/null @@ -1,46 +0,0 @@ -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 deleted file mode 100644 index 200a2e51d0..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Setup.hs +++ /dev/null @@ -1,3 +0,0 @@ -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 deleted file mode 100644 index 8b8ca837b8..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Graph.hs +++ /dev/null @@ -1,45 +0,0 @@ -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 deleted file mode 100644 index 4aeb750954..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/ParenTree.hs +++ /dev/null @@ -1,20 +0,0 @@ -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 deleted file mode 100644 index f9b741fb97..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Random.hs +++ /dev/null @@ -1,16 +0,0 @@ -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 deleted file mode 100644 index 3e825c0fa4..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/benchmarks/vector-benchmarks.cabal +++ /dev/null @@ -1,37 +0,0 @@ -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 deleted file mode 100644 index 3d824b74d1..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/changelog +++ /dev/null @@ -1,75 +0,0 @@ -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 deleted file mode 100644 index 1568bb2906..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/include/vector.h +++ /dev/null @@ -1,20 +0,0 @@ -#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 deleted file mode 100644 index 8debff23a9..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/internal/GenUnboxTuple.hs +++ /dev/null @@ -1,239 +0,0 @@ -{-# 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 deleted file mode 100644 index 6fb88d4a40..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/internal/unbox-tuple-instances +++ /dev/null @@ -1,1134 +0,0 @@ -#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 deleted file mode 100644 index 5506209ebc..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/tests/Boilerplater.hs +++ /dev/null @@ -1,27 +0,0 @@ -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 deleted file mode 100644 index 43c0cee637..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/tests/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -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 deleted file mode 100644 index 6642888323..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/tests/Main.hs +++ /dev/null @@ -1,15 +0,0 @@ -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 deleted file mode 100644 index 200a2e51d0..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/tests/Setup.hs +++ /dev/null @@ -1,3 +0,0 @@ -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 deleted file mode 100644 index 09368a1999..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Bundle.hs +++ /dev/null @@ -1,163 +0,0 @@ -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 deleted file mode 100644 index 60ea8d3346..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Move.hs +++ /dev/null @@ -1,49 +0,0 @@ -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 deleted file mode 100644 index 46569d9095..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector.hs +++ /dev/null @@ -1,706 +0,0 @@ -{-# 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 deleted file mode 100644 index 5827640d84..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector/UnitTests.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# 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 deleted file mode 100644 index 86a4f2c324..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/tests/Utilities.hs +++ /dev/null @@ -1,350 +0,0 @@ -{-# 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 deleted file mode 100644 index 013d522b2c..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/vector.cabal +++ /dev/null @@ -1,251 +0,0 @@ -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 - |