diff options
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/vector/Data/Vector')
20 files changed, 13879 insertions, 0 deletions
diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle.hs new file mode 100644 index 0000000000..6b6b6236d7 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle.hs @@ -0,0 +1,655 @@ +{-# LANGUAGE CPP, FlexibleInstances, Rank2Types, BangPatterns #-} + +-- | +-- Module : Data.Vector.Fusion.Bundle +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Bundles for stream fusion +-- + +module Data.Vector.Fusion.Bundle ( + -- * Types + Step(..), Chunk(..), Bundle, MBundle, + + -- * In-place markers + inplace, + + -- * Size hints + size, sized, + + -- * Length information + length, null, + + -- * Construction + empty, singleton, cons, snoc, replicate, generate, (++), + + -- * Accessing individual elements + head, last, (!!), (!?), + + -- * Substreams + slice, init, tail, take, drop, + + -- * Mapping + map, concatMap, flatten, unbox, + + -- * Zipping + indexed, indexedR, + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + zip, zip3, zip4, zip5, zip6, + + -- * Filtering + filter, takeWhile, dropWhile, + + -- * Searching + elem, notElem, find, findIndex, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, + + -- * Specialised folds + and, or, + + -- * Unfolding + unfoldr, unfoldrN, iterateN, + + -- * Scans + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', + scanl1, scanl1', + + -- * Enumerations + enumFromStepN, enumFromTo, enumFromThenTo, + + -- * Conversions + toList, fromList, fromListN, unsafeFromList, lift, + fromVector, reVector, fromVectors, concatVectors, + + -- * Monadic combinators + mapM, mapM_, zipWithM, zipWithM_, filterM, foldM, fold1M, foldM', fold1M', + + eq, cmp, eqBy, cmpBy +) where + +import Data.Vector.Generic.Base ( Vector ) +import Data.Vector.Fusion.Bundle.Size +import Data.Vector.Fusion.Util +import Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..) ) +import Data.Vector.Fusion.Bundle.Monadic ( Chunk(..) ) +import qualified Data.Vector.Fusion.Bundle.Monadic as M +import qualified Data.Vector.Fusion.Stream.Monadic as S + +import Prelude hiding ( length, null, + replicate, (++), + head, last, (!!), + init, tail, take, drop, + map, concatMap, + zipWith, zipWith3, zip, zip3, + filter, takeWhile, dropWhile, + elem, notElem, + foldl, foldl1, foldr, foldr1, + and, or, + scanl, scanl1, + enumFromTo, enumFromThenTo, + mapM, mapM_ ) + +#if MIN_VERSION_base(4,9,0) +import Data.Functor.Classes (Eq1 (..), Ord1 (..)) +#endif + +import GHC.Base ( build ) + +-- Data.Vector.Internal.Check is unused +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- | The type of pure streams +type Bundle = M.Bundle Id + +-- | Alternative name for monadic streams +type MBundle = M.Bundle + +inplace :: (forall m. Monad m => S.Stream m a -> S.Stream m b) + -> (Size -> Size) -> Bundle v a -> Bundle v b +{-# INLINE_FUSED inplace #-} +inplace f g b = b `seq` M.fromStream (f (M.elements b)) (g (M.size b)) + +{-# RULES + +"inplace/inplace [Vector]" + forall (f1 :: forall m. Monad m => S.Stream m a -> S.Stream m a) + (f2 :: forall m. Monad m => S.Stream m a -> S.Stream m a) + g1 g2 s. + inplace f1 g1 (inplace f2 g2 s) = inplace (f1 . f2) (g1 . g2) s #-} + + + +-- | Convert a pure stream to a monadic stream +lift :: Monad m => Bundle v a -> M.Bundle m v a +{-# INLINE_FUSED lift #-} +lift (M.Bundle (Stream step s) (Stream vstep t) v sz) + = M.Bundle (Stream (return . unId . step) s) + (Stream (return . unId . vstep) t) v sz + +-- | 'Size' hint of a 'Bundle' +size :: Bundle v a -> Size +{-# INLINE size #-} +size = M.size + +-- | Attach a 'Size' hint to a 'Bundle' +sized :: Bundle v a -> Size -> Bundle v a +{-# INLINE sized #-} +sized = M.sized + +-- Length +-- ------ + +-- | Length of a 'Bundle' +length :: Bundle v a -> Int +{-# INLINE length #-} +length = unId . M.length + +-- | Check if a 'Bundle' is empty +null :: Bundle v a -> Bool +{-# INLINE null #-} +null = unId . M.null + +-- Construction +-- ------------ + +-- | Empty 'Bundle' +empty :: Bundle v a +{-# INLINE empty #-} +empty = M.empty + +-- | Singleton 'Bundle' +singleton :: a -> Bundle v a +{-# INLINE singleton #-} +singleton = M.singleton + +-- | Replicate a value to a given length +replicate :: Int -> a -> Bundle v a +{-# INLINE replicate #-} +replicate = M.replicate + +-- | Generate a stream from its indices +generate :: Int -> (Int -> a) -> Bundle v a +{-# INLINE generate #-} +generate = M.generate + +-- | Prepend an element +cons :: a -> Bundle v a -> Bundle v a +{-# INLINE cons #-} +cons = M.cons + +-- | Append an element +snoc :: Bundle v a -> a -> Bundle v a +{-# INLINE snoc #-} +snoc = M.snoc + +infixr 5 ++ +-- | Concatenate two 'Bundle's +(++) :: Bundle v a -> Bundle v a -> Bundle v a +{-# INLINE (++) #-} +(++) = (M.++) + +-- Accessing elements +-- ------------------ + +-- | First element of the 'Bundle' or error if empty +head :: Bundle v a -> a +{-# INLINE head #-} +head = unId . M.head + +-- | Last element of the 'Bundle' or error if empty +last :: Bundle v a -> a +{-# INLINE last #-} +last = unId . M.last + +infixl 9 !! +-- | Element at the given position +(!!) :: Bundle v a -> Int -> a +{-# INLINE (!!) #-} +s !! i = unId (s M.!! i) + +infixl 9 !? +-- | Element at the given position or 'Nothing' if out of bounds +(!?) :: Bundle v a -> Int -> Maybe a +{-# INLINE (!?) #-} +s !? i = unId (s M.!? i) + +-- Substreams +-- ---------- + +-- | Extract a substream of the given length starting at the given position. +slice :: Int -- ^ starting index + -> Int -- ^ length + -> Bundle v a + -> Bundle v a +{-# INLINE slice #-} +slice = M.slice + +-- | All but the last element +init :: Bundle v a -> Bundle v a +{-# INLINE init #-} +init = M.init + +-- | All but the first element +tail :: Bundle v a -> Bundle v a +{-# INLINE tail #-} +tail = M.tail + +-- | The first @n@ elements +take :: Int -> Bundle v a -> Bundle v a +{-# INLINE take #-} +take = M.take + +-- | All but the first @n@ elements +drop :: Int -> Bundle v a -> Bundle v a +{-# INLINE drop #-} +drop = M.drop + +-- Mapping +-- --------------- + +-- | Map a function over a 'Bundle' +map :: (a -> b) -> Bundle v a -> Bundle v b +{-# INLINE map #-} +map = M.map + +unbox :: Bundle v (Box a) -> Bundle v a +{-# INLINE unbox #-} +unbox = M.unbox + +concatMap :: (a -> Bundle v b) -> Bundle v a -> Bundle v b +{-# INLINE concatMap #-} +concatMap = M.concatMap + +-- Zipping +-- ------- + +-- | Pair each element in a 'Bundle' with its index +indexed :: Bundle v a -> Bundle v (Int,a) +{-# INLINE indexed #-} +indexed = M.indexed + +-- | Pair each element in a 'Bundle' with its index, starting from the right +-- and counting down +indexedR :: Int -> Bundle v a -> Bundle v (Int,a) +{-# INLINE_FUSED indexedR #-} +indexedR = M.indexedR + +-- | Zip two 'Bundle's with the given function +zipWith :: (a -> b -> c) -> Bundle v a -> Bundle v b -> Bundle v c +{-# INLINE zipWith #-} +zipWith = M.zipWith + +-- | Zip three 'Bundle's with the given function +zipWith3 :: (a -> b -> c -> d) -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d +{-# INLINE zipWith3 #-} +zipWith3 = M.zipWith3 + +zipWith4 :: (a -> b -> c -> d -> e) + -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d + -> Bundle v e +{-# INLINE zipWith4 #-} +zipWith4 = M.zipWith4 + +zipWith5 :: (a -> b -> c -> d -> e -> f) + -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d + -> Bundle v e -> Bundle v f +{-# INLINE zipWith5 #-} +zipWith5 = M.zipWith5 + +zipWith6 :: (a -> b -> c -> d -> e -> f -> g) + -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d + -> Bundle v e -> Bundle v f -> Bundle v g +{-# INLINE zipWith6 #-} +zipWith6 = M.zipWith6 + +zip :: Bundle v a -> Bundle v b -> Bundle v (a,b) +{-# INLINE zip #-} +zip = M.zip + +zip3 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v (a,b,c) +{-# INLINE zip3 #-} +zip3 = M.zip3 + +zip4 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d + -> Bundle v (a,b,c,d) +{-# INLINE zip4 #-} +zip4 = M.zip4 + +zip5 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d + -> Bundle v e -> Bundle v (a,b,c,d,e) +{-# INLINE zip5 #-} +zip5 = M.zip5 + +zip6 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d + -> Bundle v e -> Bundle v f -> Bundle v (a,b,c,d,e,f) +{-# INLINE zip6 #-} +zip6 = M.zip6 + +-- Filtering +-- --------- + +-- | Drop elements which do not satisfy the predicate +filter :: (a -> Bool) -> Bundle v a -> Bundle v a +{-# INLINE filter #-} +filter = M.filter + +-- | Longest prefix of elements that satisfy the predicate +takeWhile :: (a -> Bool) -> Bundle v a -> Bundle v a +{-# INLINE takeWhile #-} +takeWhile = M.takeWhile + +-- | Drop the longest prefix of elements that satisfy the predicate +dropWhile :: (a -> Bool) -> Bundle v a -> Bundle v a +{-# INLINE dropWhile #-} +dropWhile = M.dropWhile + +-- Searching +-- --------- + +infix 4 `elem` +-- | Check whether the 'Bundle' contains an element +elem :: Eq a => a -> Bundle v a -> Bool +{-# INLINE elem #-} +elem x = unId . M.elem x + +infix 4 `notElem` +-- | Inverse of `elem` +notElem :: Eq a => a -> Bundle v a -> Bool +{-# INLINE notElem #-} +notElem x = unId . M.notElem x + +-- | Yield 'Just' the first element matching the predicate or 'Nothing' if no +-- such element exists. +find :: (a -> Bool) -> Bundle v a -> Maybe a +{-# INLINE find #-} +find f = unId . M.find f + +-- | Yield 'Just' the index of the first element matching the predicate or +-- 'Nothing' if no such element exists. +findIndex :: (a -> Bool) -> Bundle v a -> Maybe Int +{-# INLINE findIndex #-} +findIndex f = unId . M.findIndex f + +-- Folding +-- ------- + +-- | Left fold +foldl :: (a -> b -> a) -> a -> Bundle v b -> a +{-# INLINE foldl #-} +foldl f z = unId . M.foldl f z + +-- | Left fold on non-empty 'Bundle's +foldl1 :: (a -> a -> a) -> Bundle v a -> a +{-# INLINE foldl1 #-} +foldl1 f = unId . M.foldl1 f + +-- | Left fold with strict accumulator +foldl' :: (a -> b -> a) -> a -> Bundle v b -> a +{-# INLINE foldl' #-} +foldl' f z = unId . M.foldl' f z + +-- | Left fold on non-empty 'Bundle's with strict accumulator +foldl1' :: (a -> a -> a) -> Bundle v a -> a +{-# INLINE foldl1' #-} +foldl1' f = unId . M.foldl1' f + +-- | Right fold +foldr :: (a -> b -> b) -> b -> Bundle v a -> b +{-# INLINE foldr #-} +foldr f z = unId . M.foldr f z + +-- | Right fold on non-empty 'Bundle's +foldr1 :: (a -> a -> a) -> Bundle v a -> a +{-# INLINE foldr1 #-} +foldr1 f = unId . M.foldr1 f + +-- Specialised folds +-- ----------------- + +and :: Bundle v Bool -> Bool +{-# INLINE and #-} +and = unId . M.and + +or :: Bundle v Bool -> Bool +{-# INLINE or #-} +or = unId . M.or + +-- Unfolding +-- --------- + +-- | Unfold +unfoldr :: (s -> Maybe (a, s)) -> s -> Bundle v a +{-# INLINE unfoldr #-} +unfoldr = M.unfoldr + +-- | Unfold at most @n@ elements +unfoldrN :: Int -> (s -> Maybe (a, s)) -> s -> Bundle v a +{-# INLINE unfoldrN #-} +unfoldrN = M.unfoldrN + +-- | Apply function n-1 times to value. Zeroth element is original value. +iterateN :: Int -> (a -> a) -> a -> Bundle v a +{-# INLINE iterateN #-} +iterateN = M.iterateN + +-- Scans +-- ----- + +-- | Prefix scan +prescanl :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a +{-# INLINE prescanl #-} +prescanl = M.prescanl + +-- | Prefix scan with strict accumulator +prescanl' :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a +{-# INLINE prescanl' #-} +prescanl' = M.prescanl' + +-- | Suffix scan +postscanl :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a +{-# INLINE postscanl #-} +postscanl = M.postscanl + +-- | Suffix scan with strict accumulator +postscanl' :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a +{-# INLINE postscanl' #-} +postscanl' = M.postscanl' + +-- | Haskell-style scan +scanl :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a +{-# INLINE scanl #-} +scanl = M.scanl + +-- | Haskell-style scan with strict accumulator +scanl' :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a +{-# INLINE scanl' #-} +scanl' = M.scanl' + +-- | Scan over a non-empty 'Bundle' +scanl1 :: (a -> a -> a) -> Bundle v a -> Bundle v a +{-# INLINE scanl1 #-} +scanl1 = M.scanl1 + +-- | Scan over a non-empty 'Bundle' with a strict accumulator +scanl1' :: (a -> a -> a) -> Bundle v a -> Bundle v a +{-# INLINE scanl1' #-} +scanl1' = M.scanl1' + + +-- Comparisons +-- ----------- + +-- | Check if two 'Bundle's are equal +eq :: (Eq a) => Bundle v a -> Bundle v a -> Bool +{-# INLINE eq #-} +eq = eqBy (==) + +eqBy :: (a -> b -> Bool) -> Bundle v a -> Bundle v b -> Bool +{-# INLINE eqBy #-} +eqBy e x y = unId (M.eqBy e x y) + +-- | Lexicographically compare two 'Bundle's +cmp :: (Ord a) => Bundle v a -> Bundle v a -> Ordering +{-# INLINE cmp #-} +cmp = cmpBy compare + +cmpBy :: (a -> b -> Ordering) -> Bundle v a -> Bundle v b -> Ordering +{-# INLINE cmpBy #-} +cmpBy c x y = unId (M.cmpBy c x y) + +instance Eq a => Eq (M.Bundle Id v a) where + {-# INLINE (==) #-} + (==) = eq + +instance Ord a => Ord (M.Bundle Id v a) where + {-# INLINE compare #-} + compare = cmp + +#if MIN_VERSION_base(4,9,0) +instance Eq1 (M.Bundle Id v) where + {-# INLINE liftEq #-} + liftEq = eqBy + +instance Ord1 (M.Bundle Id v) where + {-# INLINE liftCompare #-} + liftCompare = cmpBy +#endif + +-- Monadic combinators +-- ------------------- + +-- | Apply a monadic action to each element of the stream, producing a monadic +-- stream of results +mapM :: Monad m => (a -> m b) -> Bundle v a -> M.Bundle m v b +{-# INLINE mapM #-} +mapM f = M.mapM f . lift + +-- | Apply a monadic action to each element of the stream +mapM_ :: Monad m => (a -> m b) -> Bundle v a -> m () +{-# INLINE mapM_ #-} +mapM_ f = M.mapM_ f . lift + +zipWithM :: Monad m => (a -> b -> m c) -> Bundle v a -> Bundle v b -> M.Bundle m v c +{-# INLINE zipWithM #-} +zipWithM f as bs = M.zipWithM f (lift as) (lift bs) + +zipWithM_ :: Monad m => (a -> b -> m c) -> Bundle v a -> Bundle v b -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ f as bs = M.zipWithM_ f (lift as) (lift bs) + +-- | Yield a monadic stream of elements that satisfy the monadic predicate +filterM :: Monad m => (a -> m Bool) -> Bundle v a -> M.Bundle m v a +{-# INLINE filterM #-} +filterM f = M.filterM f . lift + +-- | Monadic fold +foldM :: Monad m => (a -> b -> m a) -> a -> Bundle v b -> m a +{-# INLINE foldM #-} +foldM m z = M.foldM m z . lift + +-- | Monadic fold over non-empty stream +fold1M :: Monad m => (a -> a -> m a) -> Bundle v a -> m a +{-# INLINE fold1M #-} +fold1M m = M.fold1M m . lift + +-- | Monadic fold with strict accumulator +foldM' :: Monad m => (a -> b -> m a) -> a -> Bundle v b -> m a +{-# INLINE foldM' #-} +foldM' m z = M.foldM' m z . lift + +-- | Monad fold over non-empty stream with strict accumulator +fold1M' :: Monad m => (a -> a -> m a) -> Bundle v a -> m a +{-# INLINE fold1M' #-} +fold1M' m = M.fold1M' m . lift + +-- Enumerations +-- ------------ + +-- | Yield a 'Bundle' of the given length containing the values @x@, @x+y@, +-- @x+y+y@ etc. +enumFromStepN :: Num a => a -> a -> Int -> Bundle v a +{-# INLINE enumFromStepN #-} +enumFromStepN = M.enumFromStepN + +-- | Enumerate values +-- +-- /WARNING:/ This operations can be very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromTo :: Enum a => a -> a -> Bundle v a +{-# INLINE enumFromTo #-} +enumFromTo = M.enumFromTo + +-- | Enumerate values with a given step. +-- +-- /WARNING:/ This operations is very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: Enum a => a -> a -> a -> Bundle v a +{-# INLINE enumFromThenTo #-} +enumFromThenTo = M.enumFromThenTo + +-- Conversions +-- ----------- + +-- | Convert a 'Bundle' to a list +toList :: Bundle v a -> [a] +{-# INLINE toList #-} +-- toList s = unId (M.toList s) +toList s = build (\c n -> toListFB c n s) + +-- This supports foldr/build list fusion that GHC implements +toListFB :: (a -> b -> b) -> b -> Bundle v a -> b +{-# INLINE [0] toListFB #-} +toListFB c n M.Bundle{M.sElems = Stream step t} = go t + where + go s = case unId (step s) of + Yield x s' -> x `c` go s' + Skip s' -> go s' + Done -> n + +-- | Create a 'Bundle' from a list +fromList :: [a] -> Bundle v a +{-# INLINE fromList #-} +fromList = M.fromList + +-- | Create a 'Bundle' from the first @n@ elements of a list +-- +-- > fromListN n xs = fromList (take n xs) +fromListN :: Int -> [a] -> Bundle v a +{-# INLINE fromListN #-} +fromListN = M.fromListN + +unsafeFromList :: Size -> [a] -> Bundle v a +{-# INLINE unsafeFromList #-} +unsafeFromList = M.unsafeFromList + +fromVector :: Vector v a => v a -> Bundle v a +{-# INLINE fromVector #-} +fromVector = M.fromVector + +reVector :: Bundle u a -> Bundle v a +{-# INLINE reVector #-} +reVector = M.reVector + +fromVectors :: Vector v a => [v a] -> Bundle v a +{-# INLINE fromVectors #-} +fromVectors = M.fromVectors + +concatVectors :: Vector v a => Bundle u (v a) -> Bundle v a +{-# INLINE concatVectors #-} +concatVectors = M.concatVectors + +-- | Create a 'Bundle' of values from a 'Bundle' of streamable things +flatten :: (a -> s) -> (s -> Step s b) -> Size -> Bundle v a -> Bundle v b +{-# INLINE_FUSED flatten #-} +flatten mk istep sz = M.flatten (return . mk) (return . istep) sz . lift + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Monadic.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Monadic.hs new file mode 100644 index 0000000000..46f4a165f8 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Monadic.hs @@ -0,0 +1,1106 @@ +{-# LANGUAGE CPP, ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, Rank2Types, BangPatterns, KindSignatures, GADTs, ScopedTypeVariables #-} + +-- | +-- Module : Data.Vector.Fusion.Bundle.Monadic +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Monadic bundles. +-- + +module Data.Vector.Fusion.Bundle.Monadic ( + Bundle(..), Chunk(..), + + -- * Size hints + size, sized, + + -- * Length + length, null, + + -- * Construction + empty, singleton, cons, snoc, replicate, replicateM, generate, generateM, (++), + + -- * Accessing elements + head, last, (!!), (!?), + + -- * Substreams + slice, init, tail, take, drop, + + -- * Mapping + map, mapM, mapM_, trans, unbox, concatMap, flatten, + + -- * Zipping + indexed, indexedR, zipWithM_, + zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M, + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + zip, zip3, zip4, zip5, zip6, + + -- * Comparisons + eqBy, cmpBy, + + -- * Filtering + filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM, + + -- * Searching + elem, notElem, find, findM, findIndex, findIndexM, + + -- * Folding + foldl, foldlM, foldl1, foldl1M, foldM, fold1M, + foldl', foldlM', foldl1', foldl1M', foldM', fold1M', + foldr, foldrM, foldr1, foldr1M, + + -- * Specialised folds + and, or, concatMapM, + + -- * Unfolding + unfoldr, unfoldrM, + unfoldrN, unfoldrNM, + iterateN, iterateNM, + + -- * Scans + prescanl, prescanlM, prescanl', prescanlM', + postscanl, postscanlM, postscanl', postscanlM', + scanl, scanlM, scanl', scanlM', + scanl1, scanl1M, scanl1', scanl1M', + + -- * Enumerations + enumFromStepN, enumFromTo, enumFromThenTo, + + -- * Conversions + toList, fromList, fromListN, unsafeFromList, + fromVector, reVector, fromVectors, concatVectors, + fromStream, chunks, elements +) where + +import Data.Vector.Generic.Base +import qualified Data.Vector.Generic.Mutable.Base as M +import Data.Vector.Fusion.Bundle.Size +import Data.Vector.Fusion.Util ( Box(..), delay_inline ) +import Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..) ) +import qualified Data.Vector.Fusion.Stream.Monadic as S +import Control.Monad.Primitive + +import qualified Data.List as List +import Data.Char ( ord ) +import GHC.Base ( unsafeChr ) +import Control.Monad ( liftM ) +import Prelude hiding ( length, null, + replicate, (++), + head, last, (!!), + init, tail, take, drop, + map, mapM, mapM_, concatMap, + zipWith, zipWith3, zip, zip3, + filter, takeWhile, dropWhile, + elem, notElem, + foldl, foldl1, foldr, foldr1, + and, or, + scanl, scanl1, + enumFromTo, enumFromThenTo ) + +import Data.Int ( Int8, Int16, Int32 ) +import Data.Word ( Word8, Word16, Word32, Word64 ) + +#if !MIN_VERSION_base(4,8,0) +import Data.Word ( Word ) +#endif + +#include "vector.h" +#include "MachDeps.h" + +#if WORD_SIZE_IN_BITS > 32 +import Data.Int ( Int64 ) +#endif + +data Chunk v a = Chunk Int (forall m. (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m ()) + +-- | Monadic streams +data Bundle m v a = Bundle { sElems :: Stream m a + , sChunks :: Stream m (Chunk v a) + , sVector :: Maybe (v a) + , sSize :: Size + } + +fromStream :: Monad m => Stream m a -> Size -> Bundle m v a +{-# INLINE fromStream #-} +fromStream (Stream step t) sz = Bundle (Stream step t) (Stream step' t) Nothing sz + where + step' s = do r <- step s + return $ fmap (\x -> Chunk 1 (\v -> M.basicUnsafeWrite v 0 x)) r + +chunks :: Bundle m v a -> Stream m (Chunk v a) +{-# INLINE chunks #-} +chunks = sChunks + +elements :: Bundle m v a -> Stream m a +{-# INLINE elements #-} +elements = sElems + +-- | 'Size' hint of a 'Bundle' +size :: Bundle m v a -> Size +{-# INLINE size #-} +size = sSize + +-- | Attach a 'Size' hint to a 'Bundle' +sized :: Bundle m v a -> Size -> Bundle m v a +{-# INLINE_FUSED sized #-} +sized s sz = s { sSize = sz } + +-- Length +-- ------ + +-- | Length of a 'Bundle' +length :: Monad m => Bundle m v a -> m Int +{-# INLINE_FUSED length #-} +length Bundle{sSize = Exact n} = return n +length Bundle{sChunks = s} = S.foldl' (\n (Chunk k _) -> n+k) 0 s + +-- | Check if a 'Bundle' is empty +null :: Monad m => Bundle m v a -> m Bool +{-# INLINE_FUSED null #-} +null Bundle{sSize = Exact n} = return (n == 0) +null Bundle{sChunks = s} = S.foldr (\(Chunk n _) z -> n == 0 && z) True s + +-- Construction +-- ------------ + +-- | Empty 'Bundle' +empty :: Monad m => Bundle m v a +{-# INLINE_FUSED empty #-} +empty = fromStream S.empty (Exact 0) + +-- | Singleton 'Bundle' +singleton :: Monad m => a -> Bundle m v a +{-# INLINE_FUSED singleton #-} +singleton x = fromStream (S.singleton x) (Exact 1) + +-- | Replicate a value to a given length +replicate :: Monad m => Int -> a -> Bundle m v a +{-# INLINE_FUSED replicate #-} +replicate n x = Bundle (S.replicate n x) + (S.singleton $ Chunk len (\v -> M.basicSet v x)) + Nothing + (Exact len) + where + len = delay_inline max n 0 + +-- | Yield a 'Bundle' of values obtained by performing the monadic action the +-- given number of times +replicateM :: Monad m => Int -> m a -> Bundle m v a +{-# INLINE_FUSED replicateM #-} +-- NOTE: We delay inlining max here because GHC will create a join point for +-- the call to newArray# otherwise which is not really nice. +replicateM n p = fromStream (S.replicateM n p) (Exact (delay_inline max n 0)) + +generate :: Monad m => Int -> (Int -> a) -> Bundle m v a +{-# INLINE generate #-} +generate n f = generateM n (return . f) + +-- | Generate a stream from its indices +generateM :: Monad m => Int -> (Int -> m a) -> Bundle m v a +{-# INLINE_FUSED generateM #-} +generateM n f = fromStream (S.generateM n f) (Exact (delay_inline max n 0)) + +-- | Prepend an element +cons :: Monad m => a -> Bundle m v a -> Bundle m v a +{-# INLINE cons #-} +cons x s = singleton x ++ s + +-- | Append an element +snoc :: Monad m => Bundle m v a -> a -> Bundle m v a +{-# INLINE snoc #-} +snoc s x = s ++ singleton x + +infixr 5 ++ +-- | Concatenate two 'Bundle's +(++) :: Monad m => Bundle m v a -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED (++) #-} +Bundle sa ta _ na ++ Bundle sb tb _ nb = Bundle (sa S.++ sb) (ta S.++ tb) Nothing (na + nb) + +-- Accessing elements +-- ------------------ + +-- | First element of the 'Bundle' or error if empty +head :: Monad m => Bundle m v a -> m a +{-# INLINE_FUSED head #-} +head = S.head . sElems + +-- | Last element of the 'Bundle' or error if empty +last :: Monad m => Bundle m v a -> m a +{-# INLINE_FUSED last #-} +last = S.last . sElems + +infixl 9 !! +-- | Element at the given position +(!!) :: Monad m => Bundle m v a -> Int -> m a +{-# INLINE (!!) #-} +b !! i = sElems b S.!! i + +infixl 9 !? +-- | Element at the given position or 'Nothing' if out of bounds +(!?) :: Monad m => Bundle m v a -> Int -> m (Maybe a) +{-# INLINE (!?) #-} +b !? i = sElems b S.!? i + +-- Substreams +-- ---------- + +-- | Extract a substream of the given length starting at the given position. +slice :: Monad m => Int -- ^ starting index + -> Int -- ^ length + -> Bundle m v a + -> Bundle m v a +{-# INLINE slice #-} +slice i n s = take n (drop i s) + +-- | All but the last element +init :: Monad m => Bundle m v a -> Bundle m v a +{-# INLINE_FUSED init #-} +init Bundle{sElems = s, sSize = sz} = fromStream (S.init s) (sz-1) + +-- | All but the first element +tail :: Monad m => Bundle m v a -> Bundle m v a +{-# INLINE_FUSED tail #-} +tail Bundle{sElems = s, sSize = sz} = fromStream (S.tail s) (sz-1) + +-- | The first @n@ elements +take :: Monad m => Int -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED take #-} +take n Bundle{sElems = s, sSize = sz} = fromStream (S.take n s) (smaller (Exact n) sz) + +-- | All but the first @n@ elements +drop :: Monad m => Int -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED drop #-} +drop n Bundle{sElems = s, sSize = sz} = + fromStream (S.drop n s) (clampedSubtract sz (Exact n)) + +-- Mapping +-- ------- + +instance Monad m => Functor (Bundle m v) where + {-# INLINE fmap #-} + fmap = map + +-- | Map a function over a 'Bundle' +map :: Monad m => (a -> b) -> Bundle m v a -> Bundle m v b +{-# INLINE map #-} +map f = mapM (return . f) + +-- | Map a monadic function over a 'Bundle' +mapM :: Monad m => (a -> m b) -> Bundle m v a -> Bundle m v b +{-# INLINE_FUSED mapM #-} +mapM f Bundle{sElems = s, sSize = n} = fromStream (S.mapM f s) n + +-- | Execute a monadic action for each element of the 'Bundle' +mapM_ :: Monad m => (a -> m b) -> Bundle m v a -> m () +{-# INLINE_FUSED mapM_ #-} +mapM_ m = S.mapM_ m . sElems + +-- | Transform a 'Bundle' to use a different monad +trans :: (Monad m, Monad m') => (forall z. m z -> m' z) + -> Bundle m v a -> Bundle m' v a +{-# INLINE_FUSED trans #-} +trans f Bundle{sElems = s, sChunks = cs, sVector = v, sSize = n} + = Bundle { sElems = S.trans f s, sChunks = S.trans f cs, sVector = v, sSize = n } + +unbox :: Monad m => Bundle m v (Box a) -> Bundle m v a +{-# INLINE_FUSED unbox #-} +unbox Bundle{sElems = s, sSize = n} = fromStream (S.unbox s) n + +-- Zipping +-- ------- + +-- | Pair each element in a 'Bundle' with its index +indexed :: Monad m => Bundle m v a -> Bundle m v (Int,a) +{-# INLINE_FUSED indexed #-} +indexed Bundle{sElems = s, sSize = n} = fromStream (S.indexed s) n + +-- | Pair each element in a 'Bundle' with its index, starting from the right +-- and counting down +indexedR :: Monad m => Int -> Bundle m v a -> Bundle m v (Int,a) +{-# INLINE_FUSED indexedR #-} +indexedR m Bundle{sElems = s, sSize = n} = fromStream (S.indexedR m s) n + +-- | Zip two 'Bundle's with the given monadic function +zipWithM :: Monad m => (a -> b -> m c) -> Bundle m v a -> Bundle m v b -> Bundle m v c +{-# INLINE_FUSED zipWithM #-} +zipWithM f Bundle{sElems = sa, sSize = na} + Bundle{sElems = sb, sSize = nb} = fromStream (S.zipWithM f sa sb) (smaller na nb) + +-- FIXME: This might expose an opportunity for inplace execution. +{-# RULES + +"zipWithM xs xs [Vector.Bundle]" forall f xs. + zipWithM f xs xs = mapM (\x -> f x x) xs #-} + + +zipWithM_ :: Monad m => (a -> b -> m c) -> Bundle m v a -> Bundle m v b -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ f sa sb = S.zipWithM_ f (sElems sa) (sElems sb) + +zipWith3M :: Monad m => (a -> b -> c -> m d) -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d +{-# INLINE_FUSED zipWith3M #-} +zipWith3M f Bundle{sElems = sa, sSize = na} + Bundle{sElems = sb, sSize = nb} + Bundle{sElems = sc, sSize = nc} + = fromStream (S.zipWith3M f sa sb sc) (smaller na (smaller nb nc)) + +zipWith4M :: Monad m => (a -> b -> c -> d -> m e) + -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e +{-# INLINE zipWith4M #-} +zipWith4M f sa sb sc sd + = zipWithM (\(a,b) (c,d) -> f a b c d) (zip sa sb) (zip sc sd) + +zipWith5M :: Monad m => (a -> b -> c -> d -> e -> m f) + -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e -> Bundle m v f +{-# INLINE zipWith5M #-} +zipWith5M f sa sb sc sd se + = zipWithM (\(a,b,c) (d,e) -> f a b c d e) (zip3 sa sb sc) (zip sd se) + +zipWith6M :: Monad m => (a -> b -> c -> d -> e -> f -> m g) + -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e -> Bundle m v f -> Bundle m v g +{-# INLINE zipWith6M #-} +zipWith6M fn sa sb sc sd se sf + = zipWithM (\(a,b,c) (d,e,f) -> fn a b c d e f) (zip3 sa sb sc) + (zip3 sd se sf) + +zipWith :: Monad m => (a -> b -> c) -> Bundle m v a -> Bundle m v b -> Bundle m v c +{-# INLINE zipWith #-} +zipWith f = zipWithM (\a b -> return (f a b)) + +zipWith3 :: Monad m => (a -> b -> c -> d) + -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d +{-# INLINE zipWith3 #-} +zipWith3 f = zipWith3M (\a b c -> return (f a b c)) + +zipWith4 :: Monad m => (a -> b -> c -> d -> e) + -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e +{-# INLINE zipWith4 #-} +zipWith4 f = zipWith4M (\a b c d -> return (f a b c d)) + +zipWith5 :: Monad m => (a -> b -> c -> d -> e -> f) + -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e -> Bundle m v f +{-# INLINE zipWith5 #-} +zipWith5 f = zipWith5M (\a b c d e -> return (f a b c d e)) + +zipWith6 :: Monad m => (a -> b -> c -> d -> e -> f -> g) + -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e -> Bundle m v f -> Bundle m v g +{-# INLINE zipWith6 #-} +zipWith6 fn = zipWith6M (\a b c d e f -> return (fn a b c d e f)) + +zip :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v (a,b) +{-# INLINE zip #-} +zip = zipWith (,) + +zip3 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v (a,b,c) +{-# INLINE zip3 #-} +zip3 = zipWith3 (,,) + +zip4 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v (a,b,c,d) +{-# INLINE zip4 #-} +zip4 = zipWith4 (,,,) + +zip5 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e -> Bundle m v (a,b,c,d,e) +{-# INLINE zip5 #-} +zip5 = zipWith5 (,,,,) + +zip6 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d + -> Bundle m v e -> Bundle m v f -> Bundle m v (a,b,c,d,e,f) +{-# INLINE zip6 #-} +zip6 = zipWith6 (,,,,,) + +-- Comparisons +-- ----------- + +-- | Check if two 'Bundle's are equal +eqBy :: (Monad m) => (a -> b -> Bool) -> Bundle m v a -> Bundle m v b -> m Bool +{-# INLINE_FUSED eqBy #-} +eqBy eq x y = S.eqBy eq (sElems x) (sElems y) + +-- | Lexicographically compare two 'Bundle's +cmpBy :: (Monad m) => (a -> b -> Ordering) -> Bundle m v a -> Bundle m v b -> m Ordering +{-# INLINE_FUSED cmpBy #-} +cmpBy cmp x y = S.cmpBy cmp (sElems x) (sElems y) + +-- Filtering +-- --------- + +-- | Drop elements which do not satisfy the predicate +filter :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a +{-# INLINE filter #-} +filter f = filterM (return . f) + +-- | Drop elements which do not satisfy the monadic predicate +filterM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED filterM #-} +filterM f Bundle{sElems = s, sSize = n} = fromStream (S.filterM f s) (toMax n) + +-- | Longest prefix of elements that satisfy the predicate +takeWhile :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a +{-# INLINE takeWhile #-} +takeWhile f = takeWhileM (return . f) + +-- | Longest prefix of elements that satisfy the monadic predicate +takeWhileM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED takeWhileM #-} +takeWhileM f Bundle{sElems = s, sSize = n} = fromStream (S.takeWhileM f s) (toMax n) + +-- | Drop the longest prefix of elements that satisfy the predicate +dropWhile :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a +{-# INLINE dropWhile #-} +dropWhile f = dropWhileM (return . f) + +-- | Drop the longest prefix of elements that satisfy the monadic predicate +dropWhileM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED dropWhileM #-} +dropWhileM f Bundle{sElems = s, sSize = n} = fromStream (S.dropWhileM f s) (toMax n) + +-- Searching +-- --------- + +infix 4 `elem` +-- | Check whether the 'Bundle' contains an element +elem :: (Monad m, Eq a) => a -> Bundle m v a -> m Bool +{-# INLINE_FUSED elem #-} +elem x = S.elem x . sElems + +infix 4 `notElem` +-- | Inverse of `elem` +notElem :: (Monad m, Eq a) => a -> Bundle m v a -> m Bool +{-# INLINE notElem #-} +notElem x = S.notElem x . sElems + +-- | Yield 'Just' the first element that satisfies the predicate or 'Nothing' +-- if no such element exists. +find :: Monad m => (a -> Bool) -> Bundle m v a -> m (Maybe a) +{-# INLINE find #-} +find f = findM (return . f) + +-- | Yield 'Just' the first element that satisfies the monadic predicate or +-- 'Nothing' if no such element exists. +findM :: Monad m => (a -> m Bool) -> Bundle m v a -> m (Maybe a) +{-# INLINE_FUSED findM #-} +findM f = S.findM f . sElems + +-- | Yield 'Just' the index of the first element that satisfies the predicate +-- or 'Nothing' if no such element exists. +findIndex :: Monad m => (a -> Bool) -> Bundle m v a -> m (Maybe Int) +{-# INLINE_FUSED findIndex #-} +findIndex f = findIndexM (return . f) + +-- | Yield 'Just' the index of the first element that satisfies the monadic +-- predicate or 'Nothing' if no such element exists. +findIndexM :: Monad m => (a -> m Bool) -> Bundle m v a -> m (Maybe Int) +{-# INLINE_FUSED findIndexM #-} +findIndexM f = S.findIndexM f . sElems + +-- Folding +-- ------- + +-- | Left fold +foldl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> m a +{-# INLINE foldl #-} +foldl f = foldlM (\a b -> return (f a b)) + +-- | Left fold with a monadic operator +foldlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a +{-# INLINE_FUSED foldlM #-} +foldlM m z = S.foldlM m z . sElems + +-- | Same as 'foldlM' +foldM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a +{-# INLINE foldM #-} +foldM = foldlM + +-- | Left fold over a non-empty 'Bundle' +foldl1 :: Monad m => (a -> a -> a) -> Bundle m v a -> m a +{-# INLINE foldl1 #-} +foldl1 f = foldl1M (\a b -> return (f a b)) + +-- | Left fold over a non-empty 'Bundle' with a monadic operator +foldl1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a +{-# INLINE_FUSED foldl1M #-} +foldl1M f = S.foldl1M f . sElems + +-- | Same as 'foldl1M' +fold1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a +{-# INLINE fold1M #-} +fold1M = foldl1M + +-- | Left fold with a strict accumulator +foldl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> m a +{-# INLINE foldl' #-} +foldl' f = foldlM' (\a b -> return (f a b)) + +-- | Left fold with a strict accumulator and a monadic operator +foldlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a +{-# INLINE_FUSED foldlM' #-} +foldlM' m z = S.foldlM' m z . sElems + +-- | Same as 'foldlM'' +foldM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a +{-# INLINE foldM' #-} +foldM' = foldlM' + +-- | Left fold over a non-empty 'Bundle' with a strict accumulator +foldl1' :: Monad m => (a -> a -> a) -> Bundle m v a -> m a +{-# INLINE foldl1' #-} +foldl1' f = foldl1M' (\a b -> return (f a b)) + +-- | Left fold over a non-empty 'Bundle' with a strict accumulator and a +-- monadic operator +foldl1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a +{-# INLINE_FUSED foldl1M' #-} +foldl1M' f = S.foldl1M' f . sElems + +-- | Same as 'foldl1M'' +fold1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a +{-# INLINE fold1M' #-} +fold1M' = foldl1M' + +-- | Right fold +foldr :: Monad m => (a -> b -> b) -> b -> Bundle m v a -> m b +{-# INLINE foldr #-} +foldr f = foldrM (\a b -> return (f a b)) + +-- | Right fold with a monadic operator +foldrM :: Monad m => (a -> b -> m b) -> b -> Bundle m v a -> m b +{-# INLINE_FUSED foldrM #-} +foldrM f z = S.foldrM f z . sElems + +-- | Right fold over a non-empty stream +foldr1 :: Monad m => (a -> a -> a) -> Bundle m v a -> m a +{-# INLINE foldr1 #-} +foldr1 f = foldr1M (\a b -> return (f a b)) + +-- | Right fold over a non-empty stream with a monadic operator +foldr1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a +{-# INLINE_FUSED foldr1M #-} +foldr1M f = S.foldr1M f . sElems + +-- Specialised folds +-- ----------------- + +and :: Monad m => Bundle m v Bool -> m Bool +{-# INLINE_FUSED and #-} +and = S.and . sElems + +or :: Monad m => Bundle m v Bool -> m Bool +{-# INLINE_FUSED or #-} +or = S.or . sElems + +concatMap :: Monad m => (a -> Bundle m v b) -> Bundle m v a -> Bundle m v b +{-# INLINE concatMap #-} +concatMap f = concatMapM (return . f) + +concatMapM :: Monad m => (a -> m (Bundle m v b)) -> Bundle m v a -> Bundle m v b +{-# INLINE_FUSED concatMapM #-} +concatMapM f Bundle{sElems = s} = fromStream (S.concatMapM (liftM sElems . f) s) Unknown + +-- | Create a 'Bundle' of values from a 'Bundle' of streamable things +flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Size + -> Bundle m v a -> Bundle m v b +{-# INLINE_FUSED flatten #-} +flatten mk istep sz Bundle{sElems = s} = fromStream (S.flatten mk istep s) sz + +-- Unfolding +-- --------- + +-- | Unfold +unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Bundle m u a +{-# INLINE_FUSED unfoldr #-} +unfoldr f = unfoldrM (return . f) + +-- | Unfold with a monadic function +unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Bundle m u a +{-# INLINE_FUSED unfoldrM #-} +unfoldrM f s = fromStream (S.unfoldrM f s) Unknown + +-- | Unfold at most @n@ elements +unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Bundle m u a +{-# INLINE_FUSED unfoldrN #-} +unfoldrN n f = unfoldrNM n (return . f) + +-- | Unfold at most @n@ elements with a monadic functions +unfoldrNM :: Monad m => Int -> (s -> m (Maybe (a, s))) -> s -> Bundle m u a +{-# INLINE_FUSED unfoldrNM #-} +unfoldrNM n f s = fromStream (S.unfoldrNM n f s) (Max (delay_inline max n 0)) + +-- | Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: Monad m => Int -> (a -> m a) -> a -> Bundle m u a +{-# INLINE_FUSED iterateNM #-} +iterateNM n f x0 = fromStream (S.iterateNM n f x0) (Exact (delay_inline max n 0)) + +-- | Apply function n times to value. Zeroth element is original value. +iterateN :: Monad m => Int -> (a -> a) -> a -> Bundle m u a +{-# INLINE_FUSED iterateN #-} +iterateN n f x0 = iterateNM n (return . f) x0 + +-- Scans +-- ----- + +-- | Prefix scan +prescanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE prescanl #-} +prescanl f = prescanlM (\a b -> return (f a b)) + +-- | Prefix scan with a monadic operator +prescanlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE_FUSED prescanlM #-} +prescanlM f z Bundle{sElems = s, sSize = sz} = fromStream (S.prescanlM f z s) sz + +-- | Prefix scan with strict accumulator +prescanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE prescanl' #-} +prescanl' f = prescanlM' (\a b -> return (f a b)) + +-- | Prefix scan with strict accumulator and a monadic operator +prescanlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE_FUSED prescanlM' #-} +prescanlM' f z Bundle{sElems = s, sSize = sz} = fromStream (S.prescanlM' f z s) sz + +-- | Suffix scan +postscanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE postscanl #-} +postscanl f = postscanlM (\a b -> return (f a b)) + +-- | Suffix scan with a monadic operator +postscanlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE_FUSED postscanlM #-} +postscanlM f z Bundle{sElems = s, sSize = sz} = fromStream (S.postscanlM f z s) sz + +-- | Suffix scan with strict accumulator +postscanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE postscanl' #-} +postscanl' f = postscanlM' (\a b -> return (f a b)) + +-- | Suffix scan with strict acccumulator and a monadic operator +postscanlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE_FUSED postscanlM' #-} +postscanlM' f z Bundle{sElems = s, sSize = sz} = fromStream (S.postscanlM' f z s) sz + +-- | Haskell-style scan +scanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE scanl #-} +scanl f = scanlM (\a b -> return (f a b)) + +-- | Haskell-style scan with a monadic operator +scanlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE scanlM #-} +scanlM f z s = z `cons` postscanlM f z s + +-- | Haskell-style scan with strict accumulator +scanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE scanl' #-} +scanl' f = scanlM' (\a b -> return (f a b)) + +-- | Haskell-style scan with strict accumulator and a monadic operator +scanlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a +{-# INLINE scanlM' #-} +scanlM' f z s = z `seq` (z `cons` postscanlM f z s) + +-- | Scan over a non-empty 'Bundle' +scanl1 :: Monad m => (a -> a -> a) -> Bundle m v a -> Bundle m v a +{-# INLINE scanl1 #-} +scanl1 f = scanl1M (\x y -> return (f x y)) + +-- | Scan over a non-empty 'Bundle' with a monadic operator +scanl1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED scanl1M #-} +scanl1M f Bundle{sElems = s, sSize = sz} = fromStream (S.scanl1M f s) sz + +-- | Scan over a non-empty 'Bundle' with a strict accumulator +scanl1' :: Monad m => (a -> a -> a) -> Bundle m v a -> Bundle m v a +{-# INLINE scanl1' #-} +scanl1' f = scanl1M' (\x y -> return (f x y)) + +-- | Scan over a non-empty 'Bundle' with a strict accumulator and a monadic +-- operator +scanl1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> Bundle m v a +{-# INLINE_FUSED scanl1M' #-} +scanl1M' f Bundle{sElems = s, sSize = sz} = fromStream (S.scanl1M' f s) sz + +-- Enumerations +-- ------------ + +-- The Enum class is broken for this, there just doesn't seem to be a +-- way to implement this generically. We have to specialise for as many types +-- as we can but this doesn't help in polymorphic loops. + +-- | Yield a 'Bundle' of the given length containing the values @x@, @x+y@, +-- @x+y+y@ etc. +enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Bundle m v a +{-# INLINE_FUSED enumFromStepN #-} +enumFromStepN x y n = fromStream (S.enumFromStepN x y n) (Exact (delay_inline max n 0)) + +-- | Enumerate values +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromTo :: (Enum a, Monad m) => a -> a -> Bundle m v a +{-# INLINE_FUSED enumFromTo #-} +enumFromTo x y = fromList [x .. y] + +-- NOTE: We use (x+1) instead of (succ x) below because the latter checks for +-- overflow which can't happen here. + +-- FIXME: add "too large" test for Int +enumFromTo_small :: (Integral a, Monad m) => a -> a -> Bundle m v a +{-# INLINE_FUSED enumFromTo_small #-} +enumFromTo_small x y = x `seq` y `seq` fromStream (Stream step x) (Exact n) + where + n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0 + + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Int8> [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Bundle m v Int8 + +"enumFromTo<Int16> [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Bundle m v Int16 + +"enumFromTo<Word8> [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Bundle m v Word8 + +"enumFromTo<Word16> [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Bundle m v Word16 #-} + + + +#if WORD_SIZE_IN_BITS > 32 + +{-# RULES + +"enumFromTo<Int32> [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Bundle m v Int32 + +"enumFromTo<Word32> [Bundle]" + enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Bundle m v Word32 #-} + +#endif + +-- NOTE: We could implement a generic "too large" test: +-- +-- len x y | x > y = 0 +-- | n > 0 && n <= fromIntegral (maxBound :: Int) = fromIntegral n +-- | otherwise = error +-- where +-- n = y-x+1 +-- +-- Alas, GHC won't eliminate unnecessary comparisons (such as n >= 0 for +-- unsigned types). See http://hackage.haskell.org/trac/ghc/ticket/3744 +-- + +enumFromTo_int :: forall m v. Monad m => Int -> Int -> Bundle m v Int +{-# INLINE_FUSED enumFromTo_int #-} +enumFromTo_int x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y)) + where + {-# INLINE [0] len #-} + len :: Int -> Int -> Int + len u v | u > v = 0 + | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" + (n > 0) + $ n + where + n = v-u+1 + + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +enumFromTo_intlike :: (Integral a, Monad m) => a -> a -> Bundle m v a +{-# INLINE_FUSED enumFromTo_intlike #-} +enumFromTo_intlike x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y)) + where + {-# INLINE [0] len #-} + len u v | u > v = 0 + | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" + (n > 0) + $ fromIntegral n + where + n = v-u+1 + + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Int> [Bundle]" + enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Bundle m v Int + +#if WORD_SIZE_IN_BITS > 32 + +"enumFromTo<Int64> [Bundle]" + enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Bundle m v Int64 #-} + +#else + +"enumFromTo<Int32> [Bundle]" + enumFromTo = enumFromTo_intlike :: Monad m => Int32 -> Int32 -> Bundle m v Int32 #-} + +#endif + + + +enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Bundle m v a +{-# INLINE_FUSED enumFromTo_big_word #-} +enumFromTo_big_word x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y)) + where + {-# INLINE [0] len #-} + len u v | u > v = 0 + | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" + (n < fromIntegral (maxBound :: Int)) + $ fromIntegral (n+1) + where + n = v-u + + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Word> [Bundle]" + enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Bundle m v Word + +"enumFromTo<Word64> [Bundle]" + enumFromTo = enumFromTo_big_word + :: Monad m => Word64 -> Word64 -> Bundle m v Word64 + +#if WORD_SIZE_IN_BITS == 32 + +"enumFromTo<Word32> [Bundle]" + enumFromTo = enumFromTo_big_word + :: Monad m => Word32 -> Word32 -> Bundle m v Word32 + +#endif + +"enumFromTo<Integer> [Bundle]" + enumFromTo = enumFromTo_big_word + :: Monad m => Integer -> Integer -> Bundle m v Integer #-} + + +#if WORD_SIZE_IN_BITS > 32 + +-- FIXME: the "too large" test is totally wrong +enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Bundle m v a +{-# INLINE_FUSED enumFromTo_big_int #-} +enumFromTo_big_int x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y)) + where + {-# INLINE [0] len #-} + len u v | u > v = 0 + | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" + (n > 0 && n <= fromIntegral (maxBound :: Int)) + $ fromIntegral n + where + n = v-u+1 + + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + + +{-# RULES + +"enumFromTo<Int64> [Bundle]" + enumFromTo = enumFromTo_big_int :: Monad m => Int64 -> Int64 -> Bundle m v Int64 #-} + + + +#endif + +enumFromTo_char :: Monad m => Char -> Char -> Bundle m v Char +{-# INLINE_FUSED enumFromTo_char #-} +enumFromTo_char x y = x `seq` y `seq` fromStream (Stream step xn) (Exact n) + where + xn = ord x + yn = ord y + + n = delay_inline max 0 (yn - xn + 1) + + {-# INLINE_INNER step #-} + step zn | zn <= yn = return $ Yield (unsafeChr zn) (zn+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Char> [Bundle]" + enumFromTo = enumFromTo_char #-} + + + +------------------------------------------------------------------------ + +-- Specialise enumFromTo for Float and Double. +-- Also, try to do something about pairs? + +enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Bundle m v a +{-# INLINE_FUSED enumFromTo_double #-} +enumFromTo_double n m = n `seq` m `seq` fromStream (Stream step n) (Max (len n lim)) + where + lim = m + 1/2 -- important to float out + + {-# INLINE [0] len #-} + len x y | x > y = 0 + | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" + (l > 0) + $ fromIntegral l + where + l :: Integer + l = truncate (y-x)+2 + + {-# INLINE_INNER step #-} + step x | x <= lim = return $ Yield x (x+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Double> [Bundle]" + enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Bundle m v Double + +"enumFromTo<Float> [Bundle]" + enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Bundle m v Float #-} + + + +------------------------------------------------------------------------ + +-- | Enumerate values with a given step. +-- +-- /WARNING:/ This operation is very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Enum a, Monad m) => a -> a -> a -> Bundle m v a +{-# INLINE_FUSED enumFromThenTo #-} +enumFromThenTo x y z = fromList [x, y .. z] + +-- FIXME: Specialise enumFromThenTo. + +-- Conversions +-- ----------- + +-- | Convert a 'Bundle' to a list +toList :: Monad m => Bundle m v a -> m [a] +{-# INLINE toList #-} +toList = foldr (:) [] + +-- | Convert a list to a 'Bundle' +fromList :: Monad m => [a] -> Bundle m v a +{-# INLINE fromList #-} +fromList xs = unsafeFromList Unknown xs + +-- | Convert the first @n@ elements of a list to a 'Bundle' +fromListN :: Monad m => Int -> [a] -> Bundle m v a +{-# INLINE_FUSED fromListN #-} +fromListN n xs = fromStream (S.fromListN n xs) (Max (delay_inline max n 0)) + +-- | Convert a list to a 'Bundle' with the given 'Size' hint. +unsafeFromList :: Monad m => Size -> [a] -> Bundle m v a +{-# INLINE_FUSED unsafeFromList #-} +unsafeFromList sz xs = fromStream (S.fromList xs) sz + +fromVector :: (Monad m, Vector v a) => v a -> Bundle m v a +{-# INLINE_FUSED fromVector #-} +fromVector v = v `seq` n `seq` Bundle (Stream step 0) + (Stream vstep True) + (Just v) + (Exact n) + where + n = basicLength v + + {-# INLINE step #-} + step i | i >= n = return Done + | otherwise = case basicUnsafeIndexM v i of + Box x -> return $ Yield x (i+1) + + + {-# INLINE vstep #-} + vstep True = return (Yield (Chunk (basicLength v) (\mv -> basicUnsafeCopy mv v)) False) + vstep False = return Done + +fromVectors :: forall m v a. (Monad m, Vector v a) => [v a] -> Bundle m v a +{-# INLINE_FUSED fromVectors #-} +fromVectors us = Bundle (Stream pstep (Left us)) + (Stream vstep us) + Nothing + (Exact n) + where + n = List.foldl' (\k v -> k + basicLength v) 0 us + + pstep (Left []) = return Done + pstep (Left (v:vs)) = basicLength v `seq` return (Skip (Right (v,0,vs))) + + pstep (Right (v,i,vs)) + | i >= basicLength v = return $ Skip (Left vs) + | otherwise = case basicUnsafeIndexM v i of + Box x -> return $ Yield x (Right (v,i+1,vs)) + + -- FIXME: work around bug in GHC 7.6.1 + vstep :: [v a] -> m (Step [v a] (Chunk v a)) + vstep [] = return Done + vstep (v:vs) = return $ Yield (Chunk (basicLength v) + (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch" + (M.basicLength mv == basicLength v) + $ basicUnsafeCopy mv v)) vs + + +concatVectors :: (Monad m, Vector v a) => Bundle m u (v a) -> Bundle m v a +{-# INLINE_FUSED concatVectors #-} +concatVectors Bundle{sElems = Stream step t} + = Bundle (Stream pstep (Left t)) + (Stream vstep t) + Nothing + Unknown + where + pstep (Left s) = do + r <- step s + case r of + Yield v s' -> basicLength v `seq` return (Skip (Right (v,0,s'))) + Skip s' -> return (Skip (Left s')) + Done -> return Done + + pstep (Right (v,i,s)) + | i >= basicLength v = return (Skip (Left s)) + | otherwise = case basicUnsafeIndexM v i of + Box x -> return (Yield x (Right (v,i+1,s))) + + + vstep s = do + r <- step s + case r of + Yield v s' -> return (Yield (Chunk (basicLength v) + (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch" + (M.basicLength mv == basicLength v) + $ basicUnsafeCopy mv v)) s') + Skip s' -> return (Skip s') + Done -> return Done + +reVector :: Monad m => Bundle m u a -> Bundle m v a +{-# INLINE_FUSED reVector #-} +reVector Bundle{sElems = s, sSize = n} = fromStream s n + +{-# RULES + +"reVector [Vector]" + reVector = id + +"reVector/reVector [Vector]" forall s. + reVector (reVector s) = s #-} + + + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Size.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Size.hs new file mode 100644 index 0000000000..e90cf37320 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Size.hs @@ -0,0 +1,121 @@ +-- | +-- Module : Data.Vector.Fusion.Bundle.Size +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : portable +-- +-- Size hints for streams. +-- + +module Data.Vector.Fusion.Bundle.Size ( + Size(..), clampedSubtract, smaller, larger, toMax, upperBound, lowerBound +) where + +import Data.Vector.Fusion.Util ( delay_inline ) + +-- | Size hint +data Size = Exact Int -- ^ Exact size + | Max Int -- ^ Upper bound on the size + | Unknown -- ^ Unknown size + deriving( Eq, Show ) + +instance Num Size where + Exact m + Exact n = checkedAdd Exact m n + Exact m + Max n = checkedAdd Max m n + + Max m + Exact n = checkedAdd Max m n + Max m + Max n = checkedAdd Max m n + + _ + _ = Unknown + + + Exact m - Exact n = checkedSubtract Exact m n + Exact m - Max _ = Max m + + Max m - Exact n = checkedSubtract Max m n + Max m - Max _ = Max m + Max m - Unknown = Max m + + _ - _ = Unknown + + + fromInteger n = Exact (fromInteger n) + + (*) = error "vector: internal error * for Bundle.size isn't defined" + abs = error "vector: internal error abs for Bundle.size isn't defined" + signum = error "vector: internal error signum for Bundle.size isn't defined" + +{-# INLINE checkedAdd #-} +checkedAdd :: (Int -> Size) -> Int -> Int -> Size +checkedAdd con m n + -- Note: we assume m and n are >= 0. + | r < m || r < n = + error $ "Data.Vector.Fusion.Bundle.Size.checkedAdd: overflow: " ++ show r + | otherwise = con r + where + r = m + n + +{-# INLINE checkedSubtract #-} +checkedSubtract :: (Int -> Size) -> Int -> Int -> Size +checkedSubtract con m n + | r < 0 = + error $ "Data.Vector.Fusion.Bundle.Size.checkedSubtract: underflow: " ++ show r + | otherwise = con r + where + r = m - n + +-- | Subtract two sizes with clamping to 0, for drop-like things +{-# INLINE clampedSubtract #-} +clampedSubtract :: Size -> Size -> Size +clampedSubtract (Exact m) (Exact n) = Exact (max 0 (m - n)) +clampedSubtract (Max m) (Exact n) + | m <= n = Exact 0 + | otherwise = Max (m - n) +clampedSubtract (Exact m) (Max _) = Max m +clampedSubtract (Max m) (Max _) = Max m +clampedSubtract _ _ = Unknown + +-- | Minimum of two size hints +smaller :: Size -> Size -> Size +{-# INLINE smaller #-} +smaller (Exact m) (Exact n) = Exact (delay_inline min m n) +smaller (Exact m) (Max n) = Max (delay_inline min m n) +smaller (Exact m) Unknown = Max m +smaller (Max m) (Exact n) = Max (delay_inline min m n) +smaller (Max m) (Max n) = Max (delay_inline min m n) +smaller (Max m) Unknown = Max m +smaller Unknown (Exact n) = Max n +smaller Unknown (Max n) = Max n +smaller Unknown Unknown = Unknown + +-- | Maximum of two size hints +larger :: Size -> Size -> Size +{-# INLINE larger #-} +larger (Exact m) (Exact n) = Exact (delay_inline max m n) +larger (Exact m) (Max n) | m >= n = Exact m + | otherwise = Max n +larger (Max m) (Exact n) | n >= m = Exact n + | otherwise = Max m +larger (Max m) (Max n) = Max (delay_inline max m n) +larger _ _ = Unknown + +-- | Convert a size hint to an upper bound +toMax :: Size -> Size +toMax (Exact n) = Max n +toMax (Max n) = Max n +toMax Unknown = Unknown + +-- | Compute the minimum size from a size hint +lowerBound :: Size -> Int +lowerBound (Exact n) = n +lowerBound _ = 0 + +-- | Compute the maximum size from a size hint if possible +upperBound :: Size -> Maybe Int +upperBound (Exact n) = Just n +upperBound (Max n) = Just n +upperBound Unknown = Nothing + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Stream/Monadic.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Stream/Monadic.hs new file mode 100644 index 0000000000..cca002ca6f --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Stream/Monadic.hs @@ -0,0 +1,1639 @@ +{-# LANGUAGE CPP, ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, Rank2Types, BangPatterns, KindSignatures, GADTs, ScopedTypeVariables #-} + +-- | +-- Module : Data.Vector.Fusion.Stream.Monadic +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Monadic stream combinators. +-- + +module Data.Vector.Fusion.Stream.Monadic ( + Stream(..), Step(..), SPEC(..), + + -- * Length + length, null, + + -- * Construction + empty, singleton, cons, snoc, replicate, replicateM, generate, generateM, (++), + + -- * Accessing elements + head, last, (!!), (!?), + + -- * Substreams + slice, init, tail, take, drop, + + -- * Mapping + map, mapM, mapM_, trans, unbox, concatMap, flatten, + + -- * Zipping + indexed, indexedR, zipWithM_, + zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M, + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + zip, zip3, zip4, zip5, zip6, + + -- * Comparisons + eqBy, cmpBy, + + -- * Filtering + filter, filterM, uniq, mapMaybe, takeWhile, takeWhileM, dropWhile, dropWhileM, + + -- * Searching + elem, notElem, find, findM, findIndex, findIndexM, + + -- * Folding + foldl, foldlM, foldl1, foldl1M, foldM, fold1M, + foldl', foldlM', foldl1', foldl1M', foldM', fold1M', + foldr, foldrM, foldr1, foldr1M, + + -- * Specialised folds + and, or, concatMapM, + + -- * Unfolding + unfoldr, unfoldrM, + unfoldrN, unfoldrNM, + iterateN, iterateNM, + + -- * Scans + prescanl, prescanlM, prescanl', prescanlM', + postscanl, postscanlM, postscanl', postscanlM', + scanl, scanlM, scanl', scanlM', + scanl1, scanl1M, scanl1', scanl1M', + + -- * Enumerations + enumFromStepN, enumFromTo, enumFromThenTo, + + -- * Conversions + toList, fromList, fromListN +) where + +import Data.Vector.Fusion.Util ( Box(..) ) + +import Data.Char ( ord ) +import GHC.Base ( unsafeChr ) +import Control.Monad ( liftM ) +import Prelude hiding ( length, null, + replicate, (++), + head, last, (!!), + init, tail, take, drop, + map, mapM, mapM_, concatMap, + zipWith, zipWith3, zip, zip3, + filter, takeWhile, dropWhile, + elem, notElem, + foldl, foldl1, foldr, foldr1, + and, or, + scanl, scanl1, + enumFromTo, enumFromThenTo ) + +import Data.Int ( Int8, Int16, Int32 ) +import Data.Word ( Word8, Word16, Word32, Word64 ) + +#if !MIN_VERSION_base(4,8,0) +import Data.Word ( Word8, Word16, Word32, Word, Word64 ) +#endif + +#if __GLASGOW_HASKELL__ >= 708 +import GHC.Types ( SPEC(..) ) +#elif __GLASGOW_HASKELL__ >= 700 +import GHC.Exts ( SpecConstrAnnotation(..) ) +#endif + +#include "vector.h" +#include "MachDeps.h" + +#if WORD_SIZE_IN_BITS > 32 +import Data.Int ( Int64 ) +#endif + +#if __GLASGOW_HASKELL__ < 708 +data SPEC = SPEC | SPEC2 +#if __GLASGOW_HASKELL__ >= 700 +{-# ANN type SPEC ForceSpecConstr #-} +#endif +#endif + +emptyStream :: String +{-# NOINLINE emptyStream #-} +emptyStream = "empty stream" + +#define EMPTY_STREAM (\state -> ERROR state emptyStream) + +-- | Result of taking a single step in a stream +data Step s a where + Yield :: a -> s -> Step s a + Skip :: s -> Step s a + Done :: Step s a + +instance Functor (Step s) where + {-# INLINE fmap #-} + fmap f (Yield x s) = Yield (f x) s + fmap _ (Skip s) = Skip s + fmap _ Done = Done + +-- | Monadic streams +data Stream m a = forall s. Stream (s -> m (Step s a)) s + +-- Length +-- ------ + +-- | Length of a 'Stream' +length :: Monad m => Stream m a -> m Int +{-# INLINE_FUSED length #-} +length = foldl' (\n _ -> n+1) 0 + +-- | Check if a 'Stream' is empty +null :: Monad m => Stream m a -> m Bool +{-# INLINE_FUSED null #-} +null (Stream step t) = null_loop t + where + null_loop s = do + r <- step s + case r of + Yield _ _ -> return False + Skip s' -> null_loop s' + Done -> return True + +-- Construction +-- ------------ + +-- | Empty 'Stream' +empty :: Monad m => Stream m a +{-# INLINE_FUSED empty #-} +empty = Stream (const (return Done)) () + +-- | Singleton 'Stream' +singleton :: Monad m => a -> Stream m a +{-# INLINE_FUSED singleton #-} +singleton x = Stream (return . step) True + where + {-# INLINE_INNER step #-} + step True = Yield x False + step False = Done + +-- | Replicate a value to a given length +replicate :: Monad m => Int -> a -> Stream m a +{-# INLINE_FUSED replicate #-} +replicate n x = replicateM n (return x) + +-- | Yield a 'Stream' of values obtained by performing the monadic action the +-- given number of times +replicateM :: Monad m => Int -> m a -> Stream m a +{-# INLINE_FUSED replicateM #-} +replicateM n p = Stream step n + where + {-# INLINE_INNER step #-} + step i | i <= 0 = return Done + | otherwise = do { x <- p; return $ Yield x (i-1) } + +generate :: Monad m => Int -> (Int -> a) -> Stream m a +{-# INLINE generate #-} +generate n f = generateM n (return . f) + +-- | Generate a stream from its indices +generateM :: Monad m => Int -> (Int -> m a) -> Stream m a +{-# INLINE_FUSED generateM #-} +generateM n f = n `seq` Stream step 0 + where + {-# INLINE_INNER step #-} + step i | i < n = do + x <- f i + return $ Yield x (i+1) + | otherwise = return Done + +-- | Prepend an element +cons :: Monad m => a -> Stream m a -> Stream m a +{-# INLINE cons #-} +cons x s = singleton x ++ s + +-- | Append an element +snoc :: Monad m => Stream m a -> a -> Stream m a +{-# INLINE snoc #-} +snoc s x = s ++ singleton x + +infixr 5 ++ +-- | Concatenate two 'Stream's +(++) :: Monad m => Stream m a -> Stream m a -> Stream m a +{-# INLINE_FUSED (++) #-} +Stream stepa ta ++ Stream stepb tb = Stream step (Left ta) + where + {-# INLINE_INNER step #-} + step (Left sa) = do + r <- stepa sa + case r of + Yield x sa' -> return $ Yield x (Left sa') + Skip sa' -> return $ Skip (Left sa') + Done -> return $ Skip (Right tb) + step (Right sb) = do + r <- stepb sb + case r of + Yield x sb' -> return $ Yield x (Right sb') + Skip sb' -> return $ Skip (Right sb') + Done -> return $ Done + +-- Accessing elements +-- ------------------ + +-- | First element of the 'Stream' or error if empty +head :: Monad m => Stream m a -> m a +{-# INLINE_FUSED head #-} +head (Stream step t) = head_loop SPEC t + where + head_loop !_ s + = do + r <- step s + case r of + Yield x _ -> return x + Skip s' -> head_loop SPEC s' + Done -> EMPTY_STREAM "head" + + + +-- | Last element of the 'Stream' or error if empty +last :: Monad m => Stream m a -> m a +{-# INLINE_FUSED last #-} +last (Stream step t) = last_loop0 SPEC t + where + last_loop0 !_ s + = do + r <- step s + case r of + Yield x s' -> last_loop1 SPEC x s' + Skip s' -> last_loop0 SPEC s' + Done -> EMPTY_STREAM "last" + + last_loop1 !_ x s + = do + r <- step s + case r of + Yield y s' -> last_loop1 SPEC y s' + Skip s' -> last_loop1 SPEC x s' + Done -> return x + +infixl 9 !! +-- | Element at the given position +(!!) :: Monad m => Stream m a -> Int -> m a +{-# INLINE (!!) #-} +Stream step t !! j | j < 0 = ERROR "!!" "negative index" + | otherwise = index_loop SPEC t j + where + index_loop !_ s i + = i `seq` + do + r <- step s + case r of + Yield x s' | i == 0 -> return x + | otherwise -> index_loop SPEC s' (i-1) + Skip s' -> index_loop SPEC s' i + Done -> EMPTY_STREAM "!!" + +infixl 9 !? +-- | Element at the given position or 'Nothing' if out of bounds +(!?) :: Monad m => Stream m a -> Int -> m (Maybe a) +{-# INLINE (!?) #-} +Stream step t !? j = index_loop SPEC t j + where + index_loop !_ s i + = i `seq` + do + r <- step s + case r of + Yield x s' | i == 0 -> return (Just x) + | otherwise -> index_loop SPEC s' (i-1) + Skip s' -> index_loop SPEC s' i + Done -> return Nothing + +-- Substreams +-- ---------- + +-- | Extract a substream of the given length starting at the given position. +slice :: Monad m => Int -- ^ starting index + -> Int -- ^ length + -> Stream m a + -> Stream m a +{-# INLINE slice #-} +slice i n s = take n (drop i s) + +-- | All but the last element +init :: Monad m => Stream m a -> Stream m a +{-# INLINE_FUSED init #-} +init (Stream step t) = Stream step' (Nothing, t) + where + {-# INLINE_INNER step' #-} + step' (Nothing, s) = liftM (\r -> + case r of + Yield x s' -> Skip (Just x, s') + Skip s' -> Skip (Nothing, s') + Done -> EMPTY_STREAM "init" + ) (step s) + + step' (Just x, s) = liftM (\r -> + case r of + Yield y s' -> Yield x (Just y, s') + Skip s' -> Skip (Just x, s') + Done -> Done + ) (step s) + +-- | All but the first element +tail :: Monad m => Stream m a -> Stream m a +{-# INLINE_FUSED tail #-} +tail (Stream step t) = Stream step' (Left t) + where + {-# INLINE_INNER step' #-} + step' (Left s) = liftM (\r -> + case r of + Yield _ s' -> Skip (Right s') + Skip s' -> Skip (Left s') + Done -> EMPTY_STREAM "tail" + ) (step s) + + step' (Right s) = liftM (\r -> + case r of + Yield x s' -> Yield x (Right s') + Skip s' -> Skip (Right s') + Done -> Done + ) (step s) + +-- | The first @n@ elements +take :: Monad m => Int -> Stream m a -> Stream m a +{-# INLINE_FUSED take #-} +take n (Stream step t) = n `seq` Stream step' (t, 0) + where + {-# INLINE_INNER step' #-} + step' (s, i) | i < n = liftM (\r -> + case r of + Yield x s' -> Yield x (s', i+1) + Skip s' -> Skip (s', i) + Done -> Done + ) (step s) + step' (_, _) = return Done + +-- | All but the first @n@ elements +drop :: Monad m => Int -> Stream m a -> Stream m a +{-# INLINE_FUSED drop #-} +drop n (Stream step t) = Stream step' (t, Just n) + where + {-# INLINE_INNER step' #-} + step' (s, Just i) | i > 0 = liftM (\r -> + case r of + Yield _ s' -> Skip (s', Just (i-1)) + Skip s' -> Skip (s', Just i) + Done -> Done + ) (step s) + | otherwise = return $ Skip (s, Nothing) + + step' (s, Nothing) = liftM (\r -> + case r of + Yield x s' -> Yield x (s', Nothing) + Skip s' -> Skip (s', Nothing) + Done -> Done + ) (step s) + +-- Mapping +-- ------- + +instance Monad m => Functor (Stream m) where + {-# INLINE fmap #-} + fmap = map + +-- | Map a function over a 'Stream' +map :: Monad m => (a -> b) -> Stream m a -> Stream m b +{-# INLINE map #-} +map f = mapM (return . f) + + +-- | Map a monadic function over a 'Stream' +mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b +{-# INLINE_FUSED mapM #-} +mapM f (Stream step t) = Stream step' t + where + {-# INLINE_INNER step' #-} + step' s = do + r <- step s + case r of + Yield x s' -> liftM (`Yield` s') (f x) + Skip s' -> return (Skip s') + Done -> return Done + +consume :: Monad m => Stream m a -> m () +{-# INLINE_FUSED consume #-} +consume (Stream step t) = consume_loop SPEC t + where + consume_loop !_ s + = do + r <- step s + case r of + Yield _ s' -> consume_loop SPEC s' + Skip s' -> consume_loop SPEC s' + Done -> return () + +-- | Execute a monadic action for each element of the 'Stream' +mapM_ :: Monad m => (a -> m b) -> Stream m a -> m () +{-# INLINE_FUSED mapM_ #-} +mapM_ m = consume . mapM m + +-- | Transform a 'Stream' to use a different monad +trans :: (Monad m, Monad m') + => (forall z. m z -> m' z) -> Stream m a -> Stream m' a +{-# INLINE_FUSED trans #-} +trans f (Stream step s) = Stream (f . step) s + +unbox :: Monad m => Stream m (Box a) -> Stream m a +{-# INLINE_FUSED unbox #-} +unbox (Stream step t) = Stream step' t + where + {-# INLINE_INNER step' #-} + step' s = do + r <- step s + case r of + Yield (Box x) s' -> return $ Yield x s' + Skip s' -> return $ Skip s' + Done -> return $ Done + +-- Zipping +-- ------- + +-- | Pair each element in a 'Stream' with its index +indexed :: Monad m => Stream m a -> Stream m (Int,a) +{-# INLINE_FUSED indexed #-} +indexed (Stream step t) = Stream step' (t,0) + where + {-# INLINE_INNER step' #-} + step' (s,i) = i `seq` + do + r <- step s + case r of + Yield x s' -> return $ Yield (i,x) (s', i+1) + Skip s' -> return $ Skip (s', i) + Done -> return Done + +-- | Pair each element in a 'Stream' with its index, starting from the right +-- and counting down +indexedR :: Monad m => Int -> Stream m a -> Stream m (Int,a) +{-# INLINE_FUSED indexedR #-} +indexedR m (Stream step t) = Stream step' (t,m) + where + {-# INLINE_INNER step' #-} + step' (s,i) = i `seq` + do + r <- step s + case r of + Yield x s' -> let i' = i-1 + in + return $ Yield (i',x) (s', i') + Skip s' -> return $ Skip (s', i) + Done -> return Done + +-- | Zip two 'Stream's with the given monadic function +zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c +{-# INLINE_FUSED zipWithM #-} +zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing) + where + {-# INLINE_INNER step #-} + step (sa, sb, Nothing) = liftM (\r -> + case r of + Yield x sa' -> Skip (sa', sb, Just x) + Skip sa' -> Skip (sa', sb, Nothing) + Done -> Done + ) (stepa sa) + + step (sa, sb, Just x) = do + r <- stepb sb + case r of + Yield y sb' -> + do + z <- f x y + return $ Yield z (sa, sb', Nothing) + Skip sb' -> return $ Skip (sa, sb', Just x) + Done -> return $ Done + +-- FIXME: This might expose an opportunity for inplace execution. +{-# RULES + +"zipWithM xs xs [Vector.Stream]" forall f xs. + zipWithM f xs xs = mapM (\x -> f x x) xs #-} + + +zipWithM_ :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ f sa sb = consume (zipWithM f sa sb) + +zipWith3M :: Monad m => (a -> b -> c -> m d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d +{-# INLINE_FUSED zipWith3M #-} +zipWith3M f (Stream stepa ta) + (Stream stepb tb) + (Stream stepc tc) = Stream step (ta, tb, tc, Nothing) + where + {-# INLINE_INNER step #-} + step (sa, sb, sc, Nothing) = do + r <- stepa sa + return $ case r of + Yield x sa' -> Skip (sa', sb, sc, Just (x, Nothing)) + Skip sa' -> Skip (sa', sb, sc, Nothing) + Done -> Done + + step (sa, sb, sc, Just (x, Nothing)) = do + r <- stepb sb + return $ case r of + Yield y sb' -> Skip (sa, sb', sc, Just (x, Just y)) + Skip sb' -> Skip (sa, sb', sc, Just (x, Nothing)) + Done -> Done + + step (sa, sb, sc, Just (x, Just y)) = do + r <- stepc sc + case r of + Yield z sc' -> f x y z >>= (\res -> return $ Yield res (sa, sb, sc', Nothing)) + Skip sc' -> return $ Skip (sa, sb, sc', Just (x, Just y)) + Done -> return $ Done + +zipWith4M :: Monad m => (a -> b -> c -> d -> m e) + -> Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e +{-# INLINE zipWith4M #-} +zipWith4M f sa sb sc sd + = zipWithM (\(a,b) (c,d) -> f a b c d) (zip sa sb) (zip sc sd) + +zipWith5M :: Monad m => (a -> b -> c -> d -> e -> m f) + -> Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e -> Stream m f +{-# INLINE zipWith5M #-} +zipWith5M f sa sb sc sd se + = zipWithM (\(a,b,c) (d,e) -> f a b c d e) (zip3 sa sb sc) (zip sd se) + +zipWith6M :: Monad m => (a -> b -> c -> d -> e -> f -> m g) + -> Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e -> Stream m f -> Stream m g +{-# INLINE zipWith6M #-} +zipWith6M fn sa sb sc sd se sf + = zipWithM (\(a,b,c) (d,e,f) -> fn a b c d e f) (zip3 sa sb sc) + (zip3 sd se sf) + +zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c +{-# INLINE zipWith #-} +zipWith f = zipWithM (\a b -> return (f a b)) + +zipWith3 :: Monad m => (a -> b -> c -> d) + -> Stream m a -> Stream m b -> Stream m c -> Stream m d +{-# INLINE zipWith3 #-} +zipWith3 f = zipWith3M (\a b c -> return (f a b c)) + +zipWith4 :: Monad m => (a -> b -> c -> d -> e) + -> Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e +{-# INLINE zipWith4 #-} +zipWith4 f = zipWith4M (\a b c d -> return (f a b c d)) + +zipWith5 :: Monad m => (a -> b -> c -> d -> e -> f) + -> Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e -> Stream m f +{-# INLINE zipWith5 #-} +zipWith5 f = zipWith5M (\a b c d e -> return (f a b c d e)) + +zipWith6 :: Monad m => (a -> b -> c -> d -> e -> f -> g) + -> Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e -> Stream m f -> Stream m g +{-# INLINE zipWith6 #-} +zipWith6 fn = zipWith6M (\a b c d e f -> return (fn a b c d e f)) + +zip :: Monad m => Stream m a -> Stream m b -> Stream m (a,b) +{-# INLINE zip #-} +zip = zipWith (,) + +zip3 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m (a,b,c) +{-# INLINE zip3 #-} +zip3 = zipWith3 (,,) + +zip4 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m (a,b,c,d) +{-# INLINE zip4 #-} +zip4 = zipWith4 (,,,) + +zip5 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e -> Stream m (a,b,c,d,e) +{-# INLINE zip5 #-} +zip5 = zipWith5 (,,,,) + +zip6 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d + -> Stream m e -> Stream m f -> Stream m (a,b,c,d,e,f) +{-# INLINE zip6 #-} +zip6 = zipWith6 (,,,,,) + +-- Comparisons +-- ----------- + +-- | Check if two 'Stream's are equal +eqBy :: (Monad m) => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool +{-# INLINE_FUSED eqBy #-} +eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2 + where + eq_loop0 !_ s1 s2 = do + r <- step1 s1 + case r of + Yield x s1' -> eq_loop1 SPEC x s1' s2 + Skip s1' -> eq_loop0 SPEC s1' s2 + Done -> eq_null s2 + + eq_loop1 !_ x s1 s2 = do + r <- step2 s2 + case r of + Yield y s2' + | eq x y -> eq_loop0 SPEC s1 s2' + | otherwise -> return False + Skip s2' -> eq_loop1 SPEC x s1 s2' + Done -> return False + + eq_null s2 = do + r <- step2 s2 + case r of + Yield _ _ -> return False + Skip s2' -> eq_null s2' + Done -> return True + +-- | Lexicographically compare two 'Stream's +cmpBy :: (Monad m) => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering +{-# INLINE_FUSED cmpBy #-} +cmpBy cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2 + where + cmp_loop0 !_ s1 s2 = do + r <- step1 s1 + case r of + Yield x s1' -> cmp_loop1 SPEC x s1' s2 + Skip s1' -> cmp_loop0 SPEC s1' s2 + Done -> cmp_null s2 + + cmp_loop1 !_ x s1 s2 = do + r <- step2 s2 + case r of + Yield y s2' -> case x `cmp` y of + EQ -> cmp_loop0 SPEC s1 s2' + c -> return c + Skip s2' -> cmp_loop1 SPEC x s1 s2' + Done -> return GT + + cmp_null s2 = do + r <- step2 s2 + case r of + Yield _ _ -> return LT + Skip s2' -> cmp_null s2' + Done -> return EQ + +-- Filtering +-- --------- + +-- | Drop elements which do not satisfy the predicate +filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a +{-# INLINE filter #-} +filter f = filterM (return . f) + +mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b +{-# INLINE_FUSED mapMaybe #-} +mapMaybe f (Stream step t) = Stream step' t + where + {-# INLINE_INNER step' #-} + step' s = do + r <- step s + case r of + Yield x s' -> do + return $ case f x of + Nothing -> Skip s' + Just b' -> Yield b' s' + Skip s' -> return $ Skip s' + Done -> return $ Done + +-- | Drop elements which do not satisfy the monadic predicate +filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a +{-# INLINE_FUSED filterM #-} +filterM f (Stream step t) = Stream step' t + where + {-# INLINE_INNER step' #-} + step' s = do + r <- step s + case r of + Yield x s' -> do + b <- f x + return $ if b then Yield x s' + else Skip s' + Skip s' -> return $ Skip s' + Done -> return $ Done + +-- | Drop repeated adjacent elements. +uniq :: (Eq a, Monad m) => Stream m a -> Stream m a +{-# INLINE_FUSED uniq #-} +uniq (Stream step st) = Stream step' (Nothing,st) + where + {-# INLINE_INNER step' #-} + step' (Nothing, s) = do r <- step s + case r of + Yield x s' -> return $ Yield x (Just x , s') + Skip s' -> return $ Skip (Nothing, s') + Done -> return Done + step' (Just x0, s) = do r <- step s + case r of + Yield x s' | x == x0 -> return $ Skip (Just x0, s') + | otherwise -> return $ Yield x (Just x , s') + Skip s' -> return $ Skip (Just x0, s') + Done -> return Done + +-- | Longest prefix of elements that satisfy the predicate +takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a +{-# INLINE takeWhile #-} +takeWhile f = takeWhileM (return . f) + +-- | Longest prefix of elements that satisfy the monadic predicate +takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a +{-# INLINE_FUSED takeWhileM #-} +takeWhileM f (Stream step t) = Stream step' t + where + {-# INLINE_INNER step' #-} + step' s = do + r <- step s + case r of + Yield x s' -> do + b <- f x + return $ if b then Yield x s' else Done + Skip s' -> return $ Skip s' + Done -> return $ Done + +-- | Drop the longest prefix of elements that satisfy the predicate +dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a +{-# INLINE dropWhile #-} +dropWhile f = dropWhileM (return . f) + +data DropWhile s a = DropWhile_Drop s | DropWhile_Yield a s | DropWhile_Next s + +-- | Drop the longest prefix of elements that satisfy the monadic predicate +dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a +{-# INLINE_FUSED dropWhileM #-} +dropWhileM f (Stream step t) = Stream step' (DropWhile_Drop t) + where + -- NOTE: we jump through hoops here to have only one Yield; local data + -- declarations would be nice! + + {-# INLINE_INNER step' #-} + step' (DropWhile_Drop s) + = do + r <- step s + case r of + Yield x s' -> do + b <- f x + return $ if b then Skip (DropWhile_Drop s') + else Skip (DropWhile_Yield x s') + Skip s' -> return $ Skip (DropWhile_Drop s') + Done -> return $ Done + + step' (DropWhile_Yield x s) = return $ Yield x (DropWhile_Next s) + + step' (DropWhile_Next s) + = liftM (\r -> + case r of + Yield x s' -> Skip (DropWhile_Yield x s') + Skip s' -> Skip (DropWhile_Next s') + Done -> Done + ) (step s) + +-- Searching +-- --------- + +infix 4 `elem` +-- | Check whether the 'Stream' contains an element +elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool +{-# INLINE_FUSED elem #-} +elem x (Stream step t) = elem_loop SPEC t + where + elem_loop !_ s + = do + r <- step s + case r of + Yield y s' | x == y -> return True + | otherwise -> elem_loop SPEC s' + Skip s' -> elem_loop SPEC s' + Done -> return False + +infix 4 `notElem` +-- | Inverse of `elem` +notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool +{-# INLINE notElem #-} +notElem x s = liftM not (elem x s) + +-- | Yield 'Just' the first element that satisfies the predicate or 'Nothing' +-- if no such element exists. +find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a) +{-# INLINE find #-} +find f = findM (return . f) + +-- | Yield 'Just' the first element that satisfies the monadic predicate or +-- 'Nothing' if no such element exists. +findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a) +{-# INLINE_FUSED findM #-} +findM f (Stream step t) = find_loop SPEC t + where + find_loop !_ s + = do + r <- step s + case r of + Yield x s' -> do + b <- f x + if b then return $ Just x + else find_loop SPEC s' + Skip s' -> find_loop SPEC s' + Done -> return Nothing + +-- | Yield 'Just' the index of the first element that satisfies the predicate +-- or 'Nothing' if no such element exists. +findIndex :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe Int) +{-# INLINE_FUSED findIndex #-} +findIndex f = findIndexM (return . f) + +-- | Yield 'Just' the index of the first element that satisfies the monadic +-- predicate or 'Nothing' if no such element exists. +findIndexM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe Int) +{-# INLINE_FUSED findIndexM #-} +findIndexM f (Stream step t) = findIndex_loop SPEC t 0 + where + findIndex_loop !_ s i + = do + r <- step s + case r of + Yield x s' -> do + b <- f x + if b then return $ Just i + else findIndex_loop SPEC s' (i+1) + Skip s' -> findIndex_loop SPEC s' i + Done -> return Nothing + +-- Folding +-- ------- + +-- | Left fold +foldl :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a +{-# INLINE foldl #-} +foldl f = foldlM (\a b -> return (f a b)) + +-- | Left fold with a monadic operator +foldlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a +{-# INLINE_FUSED foldlM #-} +foldlM m w (Stream step t) = foldlM_loop SPEC w t + where + foldlM_loop !_ z s + = do + r <- step s + case r of + Yield x s' -> do { z' <- m z x; foldlM_loop SPEC z' s' } + Skip s' -> foldlM_loop SPEC z s' + Done -> return z + +-- | Same as 'foldlM' +foldM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a +{-# INLINE foldM #-} +foldM = foldlM + +-- | Left fold over a non-empty 'Stream' +foldl1 :: Monad m => (a -> a -> a) -> Stream m a -> m a +{-# INLINE foldl1 #-} +foldl1 f = foldl1M (\a b -> return (f a b)) + +-- | Left fold over a non-empty 'Stream' with a monadic operator +foldl1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a +{-# INLINE_FUSED foldl1M #-} +foldl1M f (Stream step t) = foldl1M_loop SPEC t + where + foldl1M_loop !_ s + = do + r <- step s + case r of + Yield x s' -> foldlM f x (Stream step s') + Skip s' -> foldl1M_loop SPEC s' + Done -> EMPTY_STREAM "foldl1M" + +-- | Same as 'foldl1M' +fold1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a +{-# INLINE fold1M #-} +fold1M = foldl1M + +-- | Left fold with a strict accumulator +foldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a +{-# INLINE foldl' #-} +foldl' f = foldlM' (\a b -> return (f a b)) + +-- | Left fold with a strict accumulator and a monadic operator +foldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a +{-# INLINE_FUSED foldlM' #-} +foldlM' m w (Stream step t) = foldlM'_loop SPEC w t + where + foldlM'_loop !_ z s + = z `seq` + do + r <- step s + case r of + Yield x s' -> do { z' <- m z x; foldlM'_loop SPEC z' s' } + Skip s' -> foldlM'_loop SPEC z s' + Done -> return z + +-- | Same as 'foldlM'' +foldM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a +{-# INLINE foldM' #-} +foldM' = foldlM' + +-- | Left fold over a non-empty 'Stream' with a strict accumulator +foldl1' :: Monad m => (a -> a -> a) -> Stream m a -> m a +{-# INLINE foldl1' #-} +foldl1' f = foldl1M' (\a b -> return (f a b)) + +-- | Left fold over a non-empty 'Stream' with a strict accumulator and a +-- monadic operator +foldl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a +{-# INLINE_FUSED foldl1M' #-} +foldl1M' f (Stream step t) = foldl1M'_loop SPEC t + where + foldl1M'_loop !_ s + = do + r <- step s + case r of + Yield x s' -> foldlM' f x (Stream step s') + Skip s' -> foldl1M'_loop SPEC s' + Done -> EMPTY_STREAM "foldl1M'" + +-- | Same as 'foldl1M'' +fold1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a +{-# INLINE fold1M' #-} +fold1M' = foldl1M' + +-- | Right fold +foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b +{-# INLINE foldr #-} +foldr f = foldrM (\a b -> return (f a b)) + +-- | Right fold with a monadic operator +foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b +{-# INLINE_FUSED foldrM #-} +foldrM f z (Stream step t) = foldrM_loop SPEC t + where + foldrM_loop !_ s + = do + r <- step s + case r of + Yield x s' -> f x =<< foldrM_loop SPEC s' + Skip s' -> foldrM_loop SPEC s' + Done -> return z + +-- | Right fold over a non-empty stream +foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m a +{-# INLINE foldr1 #-} +foldr1 f = foldr1M (\a b -> return (f a b)) + +-- | Right fold over a non-empty stream with a monadic operator +foldr1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a +{-# INLINE_FUSED foldr1M #-} +foldr1M f (Stream step t) = foldr1M_loop0 SPEC t + where + foldr1M_loop0 !_ s + = do + r <- step s + case r of + Yield x s' -> foldr1M_loop1 SPEC x s' + Skip s' -> foldr1M_loop0 SPEC s' + Done -> EMPTY_STREAM "foldr1M" + + foldr1M_loop1 !_ x s + = do + r <- step s + case r of + Yield y s' -> f x =<< foldr1M_loop1 SPEC y s' + Skip s' -> foldr1M_loop1 SPEC x s' + Done -> return x + +-- Specialised folds +-- ----------------- + +and :: Monad m => Stream m Bool -> m Bool +{-# INLINE_FUSED and #-} +and (Stream step t) = and_loop SPEC t + where + and_loop !_ s + = do + r <- step s + case r of + Yield False _ -> return False + Yield True s' -> and_loop SPEC s' + Skip s' -> and_loop SPEC s' + Done -> return True + +or :: Monad m => Stream m Bool -> m Bool +{-# INLINE_FUSED or #-} +or (Stream step t) = or_loop SPEC t + where + or_loop !_ s + = do + r <- step s + case r of + Yield False s' -> or_loop SPEC s' + Yield True _ -> return True + Skip s' -> or_loop SPEC s' + Done -> return False + +concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b +{-# INLINE concatMap #-} +concatMap f = concatMapM (return . f) + +concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b +{-# INLINE_FUSED concatMapM #-} +concatMapM f (Stream step t) = Stream concatMap_go (Left t) + where + concatMap_go (Left s) = do + r <- step s + case r of + Yield a s' -> do + b_stream <- f a + return $ Skip (Right (b_stream, s')) + Skip s' -> return $ Skip (Left s') + Done -> return Done + concatMap_go (Right (Stream inner_step inner_s, s)) = do + r <- inner_step inner_s + case r of + Yield b inner_s' -> return $ Yield b (Right (Stream inner_step inner_s', s)) + Skip inner_s' -> return $ Skip (Right (Stream inner_step inner_s', s)) + Done -> return $ Skip (Left s) + +-- | Create a 'Stream' of values from a 'Stream' of streamable things +flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b +{-# INLINE_FUSED flatten #-} +flatten mk istep (Stream ostep u) = Stream step (Left u) + where + {-# INLINE_INNER step #-} + step (Left t) = do + r <- ostep t + case r of + Yield a t' -> do + s <- mk a + s `seq` return (Skip (Right (s,t'))) + Skip t' -> return $ Skip (Left t') + Done -> return $ Done + + + step (Right (s,t)) = do + r <- istep s + case r of + Yield x s' -> return $ Yield x (Right (s',t)) + Skip s' -> return $ Skip (Right (s',t)) + Done -> return $ Skip (Left t) + +-- Unfolding +-- --------- + +-- | Unfold +unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a +{-# INLINE_FUSED unfoldr #-} +unfoldr f = unfoldrM (return . f) + +-- | Unfold with a monadic function +unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a +{-# INLINE_FUSED unfoldrM #-} +unfoldrM f t = Stream step t + where + {-# INLINE_INNER step #-} + step s = liftM (\r -> + case r of + Just (x, s') -> Yield x s' + Nothing -> Done + ) (f s) + +unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Stream m a +{-# INLINE_FUSED unfoldrN #-} +unfoldrN n f = unfoldrNM n (return . f) + +-- | Unfold at most @n@ elements with a monadic functions +unfoldrNM :: Monad m => Int -> (s -> m (Maybe (a, s))) -> s -> Stream m a +{-# INLINE_FUSED unfoldrNM #-} +unfoldrNM m f t = Stream step (t,m) + where + {-# INLINE_INNER step #-} + step (s,n) | n <= 0 = return Done + | otherwise = liftM (\r -> + case r of + Just (x,s') -> Yield x (s',n-1) + Nothing -> Done + ) (f s) + +-- | Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: Monad m => Int -> (a -> m a) -> a -> Stream m a +{-# INLINE_FUSED iterateNM #-} +iterateNM n f x0 = Stream step (x0,n) + where + {-# INLINE_INNER step #-} + step (x,i) | i <= 0 = return Done + | i == n = return $ Yield x (x,i-1) + | otherwise = do a <- f x + return $ Yield a (a,i-1) + +-- | Apply function n times to value. Zeroth element is original value. +iterateN :: Monad m => Int -> (a -> a) -> a -> Stream m a +{-# INLINE_FUSED iterateN #-} +iterateN n f x0 = iterateNM n (return . f) x0 + +-- Scans +-- ----- + +-- | Prefix scan +prescanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a +{-# INLINE prescanl #-} +prescanl f = prescanlM (\a b -> return (f a b)) + +-- | Prefix scan with a monadic operator +prescanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a +{-# INLINE_FUSED prescanlM #-} +prescanlM f w (Stream step t) = Stream step' (t,w) + where + {-# INLINE_INNER step' #-} + step' (s,x) = do + r <- step s + case r of + Yield y s' -> do + z <- f x y + return $ Yield x (s', z) + Skip s' -> return $ Skip (s', x) + Done -> return Done + +-- | Prefix scan with strict accumulator +prescanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a +{-# INLINE prescanl' #-} +prescanl' f = prescanlM' (\a b -> return (f a b)) + +-- | Prefix scan with strict accumulator and a monadic operator +prescanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a +{-# INLINE_FUSED prescanlM' #-} +prescanlM' f w (Stream step t) = Stream step' (t,w) + where + {-# INLINE_INNER step' #-} + step' (s,x) = x `seq` + do + r <- step s + case r of + Yield y s' -> do + z <- f x y + return $ Yield x (s', z) + Skip s' -> return $ Skip (s', x) + Done -> return Done + +-- | Suffix scan +postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a +{-# INLINE postscanl #-} +postscanl f = postscanlM (\a b -> return (f a b)) + +-- | Suffix scan with a monadic operator +postscanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a +{-# INLINE_FUSED postscanlM #-} +postscanlM f w (Stream step t) = Stream step' (t,w) + where + {-# INLINE_INNER step' #-} + step' (s,x) = do + r <- step s + case r of + Yield y s' -> do + z <- f x y + return $ Yield z (s',z) + Skip s' -> return $ Skip (s',x) + Done -> return Done + +-- | Suffix scan with strict accumulator +postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a +{-# INLINE postscanl' #-} +postscanl' f = postscanlM' (\a b -> return (f a b)) + +-- | Suffix scan with strict acccumulator and a monadic operator +postscanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a +{-# INLINE_FUSED postscanlM' #-} +postscanlM' f w (Stream step t) = w `seq` Stream step' (t,w) + where + {-# INLINE_INNER step' #-} + step' (s,x) = x `seq` + do + r <- step s + case r of + Yield y s' -> do + z <- f x y + z `seq` return (Yield z (s',z)) + Skip s' -> return $ Skip (s',x) + Done -> return Done + +-- | Haskell-style scan +scanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a +{-# INLINE scanl #-} +scanl f = scanlM (\a b -> return (f a b)) + +-- | Haskell-style scan with a monadic operator +scanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a +{-# INLINE scanlM #-} +scanlM f z s = z `cons` postscanlM f z s + +-- | Haskell-style scan with strict accumulator +scanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a +{-# INLINE scanl' #-} +scanl' f = scanlM' (\a b -> return (f a b)) + +-- | Haskell-style scan with strict accumulator and a monadic operator +scanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a +{-# INLINE scanlM' #-} +scanlM' f z s = z `seq` (z `cons` postscanlM f z s) + +-- | Scan over a non-empty 'Stream' +scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a +{-# INLINE scanl1 #-} +scanl1 f = scanl1M (\x y -> return (f x y)) + +-- | Scan over a non-empty 'Stream' with a monadic operator +scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a +{-# INLINE_FUSED scanl1M #-} +scanl1M f (Stream step t) = Stream step' (t, Nothing) + where + {-# INLINE_INNER step' #-} + step' (s, Nothing) = do + r <- step s + case r of + Yield x s' -> return $ Yield x (s', Just x) + Skip s' -> return $ Skip (s', Nothing) + Done -> EMPTY_STREAM "scanl1M" + + step' (s, Just x) = do + r <- step s + case r of + Yield y s' -> do + z <- f x y + return $ Yield z (s', Just z) + Skip s' -> return $ Skip (s', Just x) + Done -> return Done + +-- | Scan over a non-empty 'Stream' with a strict accumulator +scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a +{-# INLINE scanl1' #-} +scanl1' f = scanl1M' (\x y -> return (f x y)) + +-- | Scan over a non-empty 'Stream' with a strict accumulator and a monadic +-- operator +scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a +{-# INLINE_FUSED scanl1M' #-} +scanl1M' f (Stream step t) = Stream step' (t, Nothing) + where + {-# INLINE_INNER step' #-} + step' (s, Nothing) = do + r <- step s + case r of + Yield x s' -> x `seq` return (Yield x (s', Just x)) + Skip s' -> return $ Skip (s', Nothing) + Done -> EMPTY_STREAM "scanl1M" + + step' (s, Just x) = x `seq` + do + r <- step s + case r of + Yield y s' -> do + z <- f x y + z `seq` return (Yield z (s', Just z)) + Skip s' -> return $ Skip (s', Just x) + Done -> return Done + +-- Enumerations +-- ------------ + +-- The Enum class is broken for this, there just doesn't seem to be a +-- way to implement this generically. We have to specialise for as many types +-- as we can but this doesn't help in polymorphic loops. + +-- | Yield a 'Stream' of the given length containing the values @x@, @x+y@, +-- @x+y+y@ etc. +enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Stream m a +{-# INLINE_FUSED enumFromStepN #-} +enumFromStepN x y n = x `seq` y `seq` n `seq` Stream step (x,n) + where + {-# INLINE_INNER step #-} + step (w,m) | m > 0 = return $ Yield w (w+y,m-1) + | otherwise = return $ Done + +-- | Enumerate values +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromTo :: (Enum a, Monad m) => a -> a -> Stream m a +{-# INLINE_FUSED enumFromTo #-} +enumFromTo x y = fromList [x .. y] + +-- NOTE: We use (x+1) instead of (succ x) below because the latter checks for +-- overflow which can't happen here. + +-- FIXME: add "too large" test for Int +enumFromTo_small :: (Integral a, Monad m) => a -> a -> Stream m a +{-# INLINE_FUSED enumFromTo_small #-} +enumFromTo_small x y = x `seq` y `seq` Stream step x + where + {-# INLINE_INNER step #-} + step w | w <= y = return $ Yield w (w+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Int8> [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Stream m Int8 + +"enumFromTo<Int16> [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Stream m Int16 + +"enumFromTo<Word8> [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Stream m Word8 + +"enumFromTo<Word16> [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Stream m Word16 #-} + + +#if WORD_SIZE_IN_BITS > 32 + +{-# RULES + +"enumFromTo<Int32> [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Stream m Int32 + +"enumFromTo<Word32> [Stream]" + enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Stream m Word32 #-} + + +#endif + +-- NOTE: We could implement a generic "too large" test: +-- +-- len x y | x > y = 0 +-- | n > 0 && n <= fromIntegral (maxBound :: Int) = fromIntegral n +-- | otherwise = error +-- where +-- n = y-x+1 +-- +-- Alas, GHC won't eliminate unnecessary comparisons (such as n >= 0 for +-- unsigned types). See http://hackage.haskell.org/trac/ghc/ticket/3744 +-- + +enumFromTo_int :: forall m. Monad m => Int -> Int -> Stream m Int +{-# INLINE_FUSED enumFromTo_int #-} +enumFromTo_int x y = x `seq` y `seq` Stream step x + where + -- {-# INLINE [0] len #-} + -- len :: Int -> Int -> Int + -- len u v | u > v = 0 + -- | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" + -- (n > 0) + -- $ n + -- where + -- n = v-u+1 + + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +enumFromTo_intlike :: (Integral a, Monad m) => a -> a -> Stream m a +{-# INLINE_FUSED enumFromTo_intlike #-} +enumFromTo_intlike x y = x `seq` y `seq` Stream step x + where + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Int> [Stream]" + enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Stream m Int + +#if WORD_SIZE_IN_BITS > 32 + +"enumFromTo<Int64> [Stream]" + enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Stream m Int64 #-} + +#else + +"enumFromTo<Int32> [Stream]" + enumFromTo = enumFromTo_intlike :: Monad m => Int32 -> Int32 -> Stream m Int32 #-} + +#endif + +enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Stream m a +{-# INLINE_FUSED enumFromTo_big_word #-} +enumFromTo_big_word x y = x `seq` y `seq` Stream step x + where + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Word> [Stream]" + enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Stream m Word + +"enumFromTo<Word64> [Stream]" + enumFromTo = enumFromTo_big_word + :: Monad m => Word64 -> Word64 -> Stream m Word64 + +#if WORD_SIZE_IN_BITS == 32 + +"enumFromTo<Word32> [Stream]" + enumFromTo = enumFromTo_big_word + :: Monad m => Word32 -> Word32 -> Stream m Word32 + +#endif + +"enumFromTo<Integer> [Stream]" + enumFromTo = enumFromTo_big_word + :: Monad m => Integer -> Integer -> Stream m Integer #-} + + + +#if WORD_SIZE_IN_BITS > 32 + +-- FIXME: the "too large" test is totally wrong +enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Stream m a +{-# INLINE_FUSED enumFromTo_big_int #-} +enumFromTo_big_int x y = x `seq` y `seq` Stream step x + where + {-# INLINE_INNER step #-} + step z | z <= y = return $ Yield z (z+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Int64> [Stream]" + enumFromTo = enumFromTo_big_int :: Monad m => Int64 -> Int64 -> Stream m Int64 #-} + + + +#endif + +enumFromTo_char :: Monad m => Char -> Char -> Stream m Char +{-# INLINE_FUSED enumFromTo_char #-} +enumFromTo_char x y = x `seq` y `seq` Stream step xn + where + xn = ord x + yn = ord y + + {-# INLINE_INNER step #-} + step zn | zn <= yn = return $ Yield (unsafeChr zn) (zn+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Char> [Stream]" + enumFromTo = enumFromTo_char #-} + + + +------------------------------------------------------------------------ + +-- Specialise enumFromTo for Float and Double. +-- Also, try to do something about pairs? + +enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Stream m a +{-# INLINE_FUSED enumFromTo_double #-} +enumFromTo_double n m = n `seq` m `seq` Stream step n + where + lim = m + 1/2 -- important to float out + + {-# INLINE_INNER step #-} + step x | x <= lim = return $ Yield x (x+1) + | otherwise = return $ Done + +{-# RULES + +"enumFromTo<Double> [Stream]" + enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Stream m Double + +"enumFromTo<Float> [Stream]" + enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Stream m Float #-} + + + +------------------------------------------------------------------------ + +-- | Enumerate values with a given step. +-- +-- /WARNING:/ This operation is very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Enum a, Monad m) => a -> a -> a -> Stream m a +{-# INLINE_FUSED enumFromThenTo #-} +enumFromThenTo x y z = fromList [x, y .. z] + +-- FIXME: Specialise enumFromThenTo. + +-- Conversions +-- ----------- + +-- | Convert a 'Stream' to a list +toList :: Monad m => Stream m a -> m [a] +{-# INLINE toList #-} +toList = foldr (:) [] + +-- | Convert a list to a 'Stream' +fromList :: Monad m => [a] -> Stream m a +{-# INLINE fromList #-} +fromList zs = Stream step zs + where + step (x:xs) = return (Yield x xs) + step [] = return Done + +-- | Convert the first @n@ elements of a list to a 'Bundle' +fromListN :: Monad m => Int -> [a] -> Stream m a +{-# INLINE_FUSED fromListN #-} +fromListN m zs = Stream step (zs,m) + where + {-# INLINE_INNER step #-} + step (_, n) | n <= 0 = return Done + step (x:xs,n) = return (Yield x (xs,n-1)) + step ([],_) = return Done + +{- +fromVector :: (Monad m, Vector v a) => v a -> Stream m a +{-# INLINE_FUSED fromVector #-} +fromVector v = v `seq` n `seq` Stream (Unf step 0) + (Unf vstep True) + (Just v) + (Exact n) + where + n = basicLength v + + {-# INLINE step #-} + step i | i >= n = return Done + | otherwise = case basicUnsafeIndexM v i of + Box x -> return $ Yield x (i+1) + + + {-# INLINE vstep #-} + vstep True = return (Yield (Chunk (basicLength v) (\mv -> basicUnsafeCopy mv v)) False) + vstep False = return Done + +fromVectors :: forall m a. (Monad m, Vector v a) => [v a] -> Stream m a +{-# INLINE_FUSED fromVectors #-} +fromVectors vs = Stream (Unf pstep (Left vs)) + (Unf vstep vs) + Nothing + (Exact n) + where + n = List.foldl' (\k v -> k + basicLength v) 0 vs + + pstep (Left []) = return Done + pstep (Left (v:vs)) = basicLength v `seq` return (Skip (Right (v,0,vs))) + + pstep (Right (v,i,vs)) + | i >= basicLength v = return $ Skip (Left vs) + | otherwise = case basicUnsafeIndexM v i of + Box x -> return $ Yield x (Right (v,i+1,vs)) + + -- FIXME: work around bug in GHC 7.6.1 + vstep :: [v a] -> m (Step [v a] (Chunk v a)) + vstep [] = return Done + vstep (v:vs) = return $ Yield (Chunk (basicLength v) + (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch" + (M.basicLength mv == basicLength v) + $ basicUnsafeCopy mv v)) vs + + +concatVectors :: (Monad m, Vector v a) => Stream m (v a) -> Stream m a +{-# INLINE_FUSED concatVectors #-} +concatVectors (Stream step s} + = Stream (Unf pstep (Left s)) + (Unf vstep s) + Nothing + Unknown + where + pstep (Left s) = do + r <- step s + case r of + Yield v s' -> basicLength v `seq` return (Skip (Right (v,0,s'))) + Skip s' -> return (Skip (Left s')) + Done -> return Done + + pstep (Right (v,i,s)) + | i >= basicLength v = return (Skip (Left s)) + | otherwise = case basicUnsafeIndexM v i of + Box x -> return (Yield x (Right (v,i+1,s))) + + + vstep s = do + r <- step s + case r of + Yield v s' -> return (Yield (Chunk (basicLength v) + (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch" + (M.basicLength mv == basicLength v) + $ basicUnsafeCopy mv v)) s') + Skip s' -> return (Skip s') + Done -> return Done + +reVector :: Monad m => Stream m a -> Stream m a +{-# INLINE_FUSED reVector #-} +reVector (Stream step s, sSize = n} = Stream step s n + +{-# RULES + +"reVector [Vector]" + reVector = id + +"reVector/reVector [Vector]" forall s. + reVector (reVector s) = s #-} + + +-} + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Util.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Util.hs new file mode 100644 index 0000000000..855bf5ddd4 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Util.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE CPP #-} +-- | +-- Module : Data.Vector.Fusion.Util +-- Copyright : (c) Roman Leshchinskiy 2009 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : portable +-- +-- Fusion-related utility types +-- + +module Data.Vector.Fusion.Util ( + Id(..), Box(..), + + delay_inline, delayed_min +) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative (Applicative(..)) +#endif + +-- | Identity monad +newtype Id a = Id { unId :: a } + +instance Functor Id where + fmap f (Id x) = Id (f x) + +instance Applicative Id where + pure = Id + Id f <*> Id x = Id (f x) + +instance Monad Id where + return = pure + Id x >>= f = f x + +-- | Box monad +data Box a = Box { unBox :: a } + +instance Functor Box where + fmap f (Box x) = Box (f x) + +instance Applicative Box where + pure = Box + Box f <*> Box x = Box (f x) + +instance Monad Box where + return = pure + Box x >>= f = f x + +-- | Delay inlining a function until late in the game (simplifier phase 0). +delay_inline :: (a -> b) -> a -> b +{-# INLINE [0] delay_inline #-} +delay_inline f = f + +-- | `min` inlined in phase 0 +delayed_min :: Int -> Int -> Int +{-# INLINE [0] delayed_min #-} +delayed_min m n = min m n diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic.hs new file mode 100644 index 0000000000..066c07fd3d --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic.hs @@ -0,0 +1,2206 @@ +{-# LANGUAGE CPP, Rank2Types, MultiParamTypeClasses, FlexibleContexts, + TypeFamilies, ScopedTypeVariables, BangPatterns #-} +-- | +-- Module : Data.Vector.Generic +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Generic interface to pure vectors. +-- + +module Data.Vector.Generic ( + -- * Immutable vectors + Vector(..), Mutable, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + unsafeIndex, unsafeHead, unsafeLast, + + -- ** Monadic indexing + indexM, headM, lastM, + unsafeIndexM, unsafeHeadM, unsafeLastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, iterateNM, create, createT, + + -- ** Unfolding + unfoldr, unfoldrN, + unfoldrM, unfoldrNM, + constructN, constructrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, concatNE, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update, update_, + unsafeUpd, unsafeUpdate, unsafeUpdate_, + + -- ** Accumulations + accum, accumulate, accumulate_, + unsafeAccum, unsafeAccumulate, unsafeAccumulate_, + + -- ** Permutations + reverse, backpermute, unsafeBackpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Indexing + indexed, + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, imapM, mapM_, imapM_, forM, forM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + zip, zip3, zip4, zip5, zip6, + + -- ** Monadic zipping + zipWithM, izipWithM, zipWithM_, izipWithM_, + + -- ** Unzipping + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, uniq, + mapMaybe, imapMaybe, + filterM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, span, break, + + -- ** Searching + elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + + -- ** Specialised folds + all, any, and, or, + sum, product, + maximum, maximumBy, minimum, minimumBy, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, ifoldM, foldM', ifoldM', + fold1M, fold1M', foldM_, ifoldM_, + foldM'_, ifoldM'_, fold1M_, fold1M'_, + + -- ** Monadic sequencing + sequence, sequence_, + + -- * Prefix sums (scans) + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + iscanl, iscanl', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + iscanr, iscanr', + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Different vector types + convert, + + -- ** Mutable vectors + freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy, + + -- * Fusion support + + -- ** Conversion to/from Bundles + stream, unstream, streamR, unstreamR, + + -- ** Recycling support + new, clone, + + -- * Utilities + + -- ** Comparisons + eq, cmp, + eqBy, cmpBy, + + -- ** Show and Read + showsPrec, readPrec, + liftShowsPrec, liftReadsPrec, + + -- ** @Data@ and @Typeable@ + gfoldl, dataCast, mkType +) where + +import Data.Vector.Generic.Base + +import qualified Data.Vector.Generic.Mutable as M + +import qualified Data.Vector.Generic.New as New +import Data.Vector.Generic.New ( New ) + +import qualified Data.Vector.Fusion.Bundle as Bundle +import Data.Vector.Fusion.Bundle ( Bundle, MBundle, lift, inplace ) +import qualified Data.Vector.Fusion.Bundle.Monadic as MBundle +import Data.Vector.Fusion.Stream.Monadic ( Stream ) +import qualified Data.Vector.Fusion.Stream.Monadic as S +import Data.Vector.Fusion.Bundle.Size +import Data.Vector.Fusion.Util + +import Control.Monad.ST ( ST, runST ) +import Control.Monad.Primitive +import Prelude hiding ( length, null, + replicate, (++), concat, + head, last, + init, tail, take, drop, splitAt, reverse, + map, concat, concatMap, + zipWith, zipWith3, zip, zip3, unzip, unzip3, + filter, takeWhile, dropWhile, span, break, + elem, notElem, + foldl, foldl1, foldr, foldr1, + all, any, and, or, sum, product, maximum, minimum, + scanl, scanl1, scanr, scanr1, + enumFromTo, enumFromThenTo, + mapM, mapM_, sequence, sequence_, + showsPrec ) + +import qualified Text.Read as Read +import qualified Data.List.NonEmpty as NonEmpty + +#if __GLASGOW_HASKELL__ >= 707 +import Data.Typeable ( Typeable, gcast1 ) +#else +import Data.Typeable ( Typeable1, gcast1 ) +#endif + +#include "vector.h" + +import Data.Data ( Data, DataType ) +#if MIN_VERSION_base(4,2,0) +import Data.Data ( mkNoRepType ) +#else +import Data.Data ( mkNorepType ) +mkNoRepType :: String -> DataType +mkNoRepType = mkNorepType +#endif + +import qualified Data.Traversable as T (Traversable(mapM)) + +-- Length information +-- ------------------ + +-- | /O(1)/ Yield the length of the vector +length :: Vector v a => v a -> Int +{-# INLINE length #-} +length = Bundle.length . stream' + +-- | /O(1)/ Test whether a vector is empty +null :: Vector v a => v a -> Bool +{-# INLINE null #-} +null = Bundle.null . stream + +-- Indexing +-- -------- + +infixl 9 ! +-- | O(1) Indexing +(!) :: Vector v a => v a -> Int -> a +{-# INLINE_FUSED (!) #-} +(!) v i = BOUNDS_CHECK(checkIndex) "(!)" i (length v) + $ unId (basicUnsafeIndexM v i) + +infixl 9 !? +-- | O(1) Safe indexing +(!?) :: Vector v a => v a -> Int -> Maybe a +{-# INLINE_FUSED (!?) #-} +v !? i | i < 0 || i >= length v = Nothing + | otherwise = Just $ unsafeIndex v i + +-- | /O(1)/ First element +head :: Vector v a => v a -> a +{-# INLINE_FUSED head #-} +head v = v ! 0 + +-- | /O(1)/ Last element +last :: Vector v a => v a -> a +{-# INLINE_FUSED last #-} +last v = v ! (length v - 1) + +-- | /O(1)/ Unsafe indexing without bounds checking +unsafeIndex :: Vector v a => v a -> Int -> a +{-# INLINE_FUSED unsafeIndex #-} +unsafeIndex v i = UNSAFE_CHECK(checkIndex) "unsafeIndex" i (length v) + $ unId (basicUnsafeIndexM v i) + +-- | /O(1)/ First element without checking if the vector is empty +unsafeHead :: Vector v a => v a -> a +{-# INLINE_FUSED unsafeHead #-} +unsafeHead v = unsafeIndex v 0 + +-- | /O(1)/ Last element without checking if the vector is empty +unsafeLast :: Vector v a => v a -> a +{-# INLINE_FUSED unsafeLast #-} +unsafeLast v = unsafeIndex v (length v - 1) + +{-# RULES + +"(!)/unstream [Vector]" forall i s. + new (New.unstream s) ! i = s Bundle.!! i + +"(!?)/unstream [Vector]" forall i s. + new (New.unstream s) !? i = s Bundle.!? i + +"head/unstream [Vector]" forall s. + head (new (New.unstream s)) = Bundle.head s + +"last/unstream [Vector]" forall s. + last (new (New.unstream s)) = Bundle.last s + +"unsafeIndex/unstream [Vector]" forall i s. + unsafeIndex (new (New.unstream s)) i = s Bundle.!! i + +"unsafeHead/unstream [Vector]" forall s. + unsafeHead (new (New.unstream s)) = Bundle.head s + +"unsafeLast/unstream [Vector]" forall s. + unsafeLast (new (New.unstream s)) = Bundle.last s #-} + + + +-- Monadic indexing +-- ---------------- + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the vector when necessary. +-- Suppose vector copying is implemented like this: +-- +-- > copy mv v = ... write mv i (v ! i) ... +-- +-- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ +-- would unnecessarily retain a reference to @v@ in each element written. +-- +-- With 'indexM', copying can be implemented like this instead: +-- +-- > copy mv v = ... do +-- > x <- indexM v i +-- > write mv i x +-- +-- Here, no references to @v@ are retained because indexing (but /not/ the +-- elements) is evaluated eagerly. +-- +indexM :: (Vector v a, Monad m) => v a -> Int -> m a +{-# INLINE_FUSED indexM #-} +indexM v i = BOUNDS_CHECK(checkIndex) "indexM" i (length v) + $ basicUnsafeIndexM v i + +-- | /O(1)/ First element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +headM :: (Vector v a, Monad m) => v a -> m a +{-# INLINE_FUSED headM #-} +headM v = indexM v 0 + +-- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +lastM :: (Vector v a, Monad m) => v a -> m a +{-# INLINE_FUSED lastM #-} +lastM v = indexM v (length v - 1) + +-- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an +-- explanation of why this is useful. +unsafeIndexM :: (Vector v a, Monad m) => v a -> Int -> m a +{-# INLINE_FUSED unsafeIndexM #-} +unsafeIndexM v i = UNSAFE_CHECK(checkIndex) "unsafeIndexM" i (length v) + $ basicUnsafeIndexM v i + +-- | /O(1)/ First element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeHeadM :: (Vector v a, Monad m) => v a -> m a +{-# INLINE_FUSED unsafeHeadM #-} +unsafeHeadM v = unsafeIndexM v 0 + +-- | /O(1)/ Last element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeLastM :: (Vector v a, Monad m) => v a -> m a +{-# INLINE_FUSED unsafeLastM #-} +unsafeLastM v = unsafeIndexM v (length v - 1) + +{-# RULES + +"indexM/unstream [Vector]" forall s i. + indexM (new (New.unstream s)) i = lift s MBundle.!! i + +"headM/unstream [Vector]" forall s. + headM (new (New.unstream s)) = MBundle.head (lift s) + +"lastM/unstream [Vector]" forall s. + lastM (new (New.unstream s)) = MBundle.last (lift s) + +"unsafeIndexM/unstream [Vector]" forall s i. + unsafeIndexM (new (New.unstream s)) i = lift s MBundle.!! i + +"unsafeHeadM/unstream [Vector]" forall s. + unsafeHeadM (new (New.unstream s)) = MBundle.head (lift s) + +"unsafeLastM/unstream [Vector]" forall s. + unsafeLastM (new (New.unstream s)) = MBundle.last (lift s) #-} + + + +-- Extracting subvectors (slicing) +-- ------------------------------- + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Vector v a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> v a + -> v a +{-# INLINE_FUSED slice #-} +slice i n v = BOUNDS_CHECK(checkSlice) "slice" i n (length v) + $ basicUnsafeSlice i n v + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty. +init :: Vector v a => v a -> v a +{-# INLINE_FUSED init #-} +init v = slice 0 (length v - 1) v + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty. +tail :: Vector v a => v a -> v a +{-# INLINE_FUSED tail #-} +tail v = slice 1 (length v - 1) v + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case it is returned unchanged. +take :: Vector v a => Int -> v a -> v a +{-# INLINE_FUSED take #-} +take n v = unsafeSlice 0 (delay_inline min n' (length v)) v + where n' = max n 0 + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case an empty vector is returned. +drop :: Vector v a => Int -> v a -> v a +{-# INLINE_FUSED drop #-} +drop n v = unsafeSlice (delay_inline min n' len) + (delay_inline max 0 (len - n')) v + where n' = max n 0 + len = length v + +-- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ +-- but slightly more efficient. +{-# INLINE_FUSED splitAt #-} +splitAt :: Vector v a => Int -> v a -> (v a, v a) +splitAt n v = ( unsafeSlice 0 m v + , unsafeSlice m (delay_inline max 0 (len - n')) v + ) + where + m = delay_inline min n' len + n' = max n 0 + len = length v + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must +-- contain at least @i+n@ elements but this is not checked. +unsafeSlice :: Vector v a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> v a + -> v a +{-# INLINE_FUSED unsafeSlice #-} +unsafeSlice i n v = UNSAFE_CHECK(checkSlice) "unsafeSlice" i n (length v) + $ basicUnsafeSlice i n v + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty but this is not checked. +unsafeInit :: Vector v a => v a -> v a +{-# INLINE_FUSED unsafeInit #-} +unsafeInit v = unsafeSlice 0 (length v - 1) v + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty but this is not checked. +unsafeTail :: Vector v a => v a -> v a +{-# INLINE_FUSED unsafeTail #-} +unsafeTail v = unsafeSlice 1 (length v - 1) v + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector must +-- contain at least @n@ elements but this is not checked. +unsafeTake :: Vector v a => Int -> v a -> v a +{-# INLINE unsafeTake #-} +unsafeTake n v = unsafeSlice 0 n v + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector +-- must contain at least @n@ elements but this is not checked. +unsafeDrop :: Vector v a => Int -> v a -> v a +{-# INLINE unsafeDrop #-} +unsafeDrop n v = unsafeSlice n (length v - n) v + +{-# RULES + +"slice/new [Vector]" forall i n p. + slice i n (new p) = new (New.slice i n p) + +"init/new [Vector]" forall p. + init (new p) = new (New.init p) + +"tail/new [Vector]" forall p. + tail (new p) = new (New.tail p) + +"take/new [Vector]" forall n p. + take n (new p) = new (New.take n p) + +"drop/new [Vector]" forall n p. + drop n (new p) = new (New.drop n p) + +"unsafeSlice/new [Vector]" forall i n p. + unsafeSlice i n (new p) = new (New.unsafeSlice i n p) + +"unsafeInit/new [Vector]" forall p. + unsafeInit (new p) = new (New.unsafeInit p) + +"unsafeTail/new [Vector]" forall p. + unsafeTail (new p) = new (New.unsafeTail p) #-} + + + +-- Initialisation +-- -------------- + +-- | /O(1)/ Empty vector +empty :: Vector v a => v a +{-# INLINE empty #-} +empty = unstream Bundle.empty + +-- | /O(1)/ Vector with exactly one element +singleton :: forall v a. Vector v a => a -> v a +{-# INLINE singleton #-} +singleton x = elemseq (undefined :: v a) x + $ unstream (Bundle.singleton x) + +-- | /O(n)/ Vector of the given length with the same value in each position +replicate :: forall v a. Vector v a => Int -> a -> v a +{-# INLINE replicate #-} +replicate n x = elemseq (undefined :: v a) x + $ unstream + $ Bundle.replicate n x + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index +generate :: Vector v a => Int -> (Int -> a) -> v a +{-# INLINE generate #-} +generate n f = unstream (Bundle.generate n f) + +-- | /O(n)/ Apply function n times to value. Zeroth element is original value. +iterateN :: Vector v a => Int -> (a -> a) -> a -> v a +{-# INLINE iterateN #-} +iterateN n f x = unstream (Bundle.iterateN n f x) + +-- Unfolding +-- --------- + +-- | /O(n)/ Construct a vector by repeatedly applying the generator function +-- to a seed. The generator function yields 'Just' the next element and the +-- new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 +-- > = <10,9,8,7,6,5,4,3,2,1> +unfoldr :: Vector v a => (b -> Maybe (a, b)) -> b -> v a +{-# INLINE unfoldr #-} +unfoldr f = unstream . Bundle.unfoldr f + +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> +unfoldrN :: Vector v a => Int -> (b -> Maybe (a, b)) -> b -> v a +{-# INLINE unfoldrN #-} +unfoldrN n f = unstream . Bundle.unfoldrN n f + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Vector v a) => (b -> m (Maybe (a, b))) -> b -> m (v a) +{-# INLINE unfoldrM #-} +unfoldrM f = unstreamM . MBundle.unfoldrM f + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Vector v a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (v a) +{-# INLINE unfoldrNM #-} +unfoldrNM n f = unstreamM . MBundle.unfoldrNM n f + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in f <a,b,c> +-- +constructN :: forall v a. Vector v a => Int -> (v a -> a) -> v a +{-# INLINE constructN #-} +-- NOTE: We *CANNOT* wrap this in New and then fuse because the elements +-- might contain references to the immutable vector! +constructN !n f = runST ( + do + v <- M.new n + v' <- unsafeFreeze v + fill v' 0 + ) + where + fill :: forall s. v a -> Int -> ST s (v a) + fill !v i | i < n = let x = f (unsafeTake i v) + in + elemseq v x $ + do + v' <- unsafeThaw v + M.unsafeWrite v' i x + v'' <- unsafeFreeze v' + fill v'' (i+1) + + fill v _ = return v + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in f <c,b,a> +-- +constructrN :: forall v a. Vector v a => Int -> (v a -> a) -> v a +{-# INLINE constructrN #-} +-- NOTE: We *CANNOT* wrap this in New and then fuse because the elements +-- might contain references to the immutable vector! +constructrN !n f = runST ( + do + v <- n `seq` M.new n + v' <- unsafeFreeze v + fill v' 0 + ) + where + fill :: forall s. v a -> Int -> ST s (v a) + fill !v i | i < n = let x = f (unsafeSlice (n-i) i v) + in + elemseq v x $ + do + v' <- unsafeThaw v + M.unsafeWrite v' (n-i-1) x + v'' <- unsafeFreeze v' + fill v'' (i+1) + + fill v _ = return v + + +-- Enumeration +-- ----------- + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ +-- etc. This operation is usually more efficient than 'enumFromTo'. +-- +-- > enumFromN 5 3 = <5,6,7> +enumFromN :: (Vector v a, Num a) => a -> Int -> v a +{-# INLINE enumFromN #-} +enumFromN x n = enumFromStepN x 1 n + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, +-- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. +-- +-- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> +enumFromStepN :: forall v a. (Vector v a, Num a) => a -> a -> Int -> v a +{-# INLINE enumFromStepN #-} +enumFromStepN x y n = elemseq (undefined :: v a) x + $ elemseq (undefined :: v a) y + $ unstream + $ Bundle.enumFromStepN x y n + +-- | /O(n)/ Enumerate values from @x@ to @y@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromN' instead. +enumFromTo :: (Vector v a, Enum a) => a -> a -> v a +{-# INLINE enumFromTo #-} +enumFromTo x y = unstream (Bundle.enumFromTo x y) + +-- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Vector v a, Enum a) => a -> a -> a -> v a +{-# INLINE enumFromThenTo #-} +enumFromThenTo x y z = unstream (Bundle.enumFromThenTo x y z) + +-- Concatenation +-- ------------- + +-- | /O(n)/ Prepend an element +cons :: forall v a. Vector v a => a -> v a -> v a +{-# INLINE cons #-} +cons x v = elemseq (undefined :: v a) x + $ unstream + $ Bundle.cons x + $ stream v + +-- | /O(n)/ Append an element +snoc :: forall v a. Vector v a => v a -> a -> v a +{-# INLINE snoc #-} +snoc v x = elemseq (undefined :: v a) x + $ unstream + $ Bundle.snoc (stream v) x + +infixr 5 ++ +-- | /O(m+n)/ Concatenate two vectors +(++) :: Vector v a => v a -> v a -> v a +{-# INLINE (++) #-} +v ++ w = unstream (stream v Bundle.++ stream w) + +-- | /O(n)/ Concatenate all vectors in the list +concat :: Vector v a => [v a] -> v a +{-# INLINE concat #-} +concat = unstream . Bundle.fromVectors +{- +concat vs = unstream (Bundle.flatten mk step (Exact n) (Bundle.fromList vs)) + where + n = List.foldl' (\k v -> k + length v) 0 vs + + {-# INLINE_INNER step #-} + step (v,i,k) + | i < k = case unsafeIndexM v i of + Box x -> Bundle.Yield x (v,i+1,k) + | otherwise = Bundle.Done + + {-# INLINE mk #-} + mk v = let k = length v + in + k `seq` (v,0,k) +-} + +-- | /O(n)/ Concatenate all vectors in the non-empty list +concatNE :: Vector v a => NonEmpty.NonEmpty (v a) -> v a +concatNE = concat . NonEmpty.toList + +-- Monadic initialisation +-- ---------------------- + +-- | /O(n)/ Execute the monadic action the given number of times and store the +-- results in a vector. +replicateM :: (Monad m, Vector v a) => Int -> m a -> m (v a) +{-# INLINE replicateM #-} +replicateM n m = unstreamM (MBundle.replicateM n m) + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +generateM :: (Monad m, Vector v a) => Int -> (Int -> m a) -> m (v a) +{-# INLINE generateM #-} +generateM n f = unstreamM (MBundle.generateM n f) + +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: (Monad m, Vector v a) => Int -> (a -> m a) -> a -> m (v a) +{-# INLINE iterateNM #-} +iterateNM n f x = unstreamM (MBundle.iterateNM n f x) + +-- | Execute the monadic action and freeze the resulting vector. +-- +-- @ +-- create (do { v \<- 'M.new' 2; 'M.write' v 0 \'a\'; 'M.write' v 1 \'b\'; return v }) = \<'a','b'\> +-- @ +create :: Vector v a => (forall s. ST s (Mutable v s a)) -> v a +{-# INLINE create #-} +create p = new (New.create p) + +-- | Execute the monadic action and freeze the resulting vectors. +createT + :: (T.Traversable f, Vector v a) + => (forall s. ST s (f (Mutable v s a))) -> f (v a) +{-# INLINE createT #-} +createT p = runST (p >>= T.mapM unsafeFreeze) + +-- Restricting memory usage +-- ------------------------ + +-- | /O(n)/ Yield the argument but force it not to retain any extra memory, +-- possibly by copying it. +-- +-- This is especially useful when dealing with slices. For example: +-- +-- > force (slice 0 2 <huge vector>) +-- +-- Here, the slice retains a reference to the huge vector. Forcing it creates +-- a copy of just the elements that belong to the slice and allows the huge +-- vector to be garbage collected. +force :: Vector v a => v a -> v a +-- FIXME: we probably ought to inline this later as the rules still might fire +-- otherwise +{-# INLINE_FUSED force #-} +force v = new (clone v) + +-- Bulk updates +-- ------------ + +-- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector +-- element at position @i@ by @a@. +-- +-- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> +-- +(//) :: Vector v a => v a -- ^ initial vector (of length @m@) + -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) + -> v a +{-# INLINE (//) #-} +v // us = update_stream v (Bundle.fromList us) + +-- | /O(m+n)/ For each pair @(i,a)@ from the vector of index/value pairs, +-- replace the vector element at position @i@ by @a@. +-- +-- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7> +-- +update :: (Vector v a, Vector v (Int, a)) + => v a -- ^ initial vector (of length @m@) + -> v (Int, a) -- ^ vector of index/value pairs (of length @n@) + -> v a +{-# INLINE update #-} +update v w = update_stream v (stream w) + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @a@ from the value vector, replace the element of the +-- initial vector at position @i@ by @a@. +-- +-- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> +-- +-- This function is useful for instances of 'Vector' that cannot store pairs. +-- Otherwise, 'update' is probably more convenient. +-- +-- @ +-- update_ xs is ys = 'update' xs ('zip' is ys) +-- @ +update_ :: (Vector v a, Vector v Int) + => v a -- ^ initial vector (of length @m@) + -> v Int -- ^ index vector (of length @n1@) + -> v a -- ^ value vector (of length @n2@) + -> v a +{-# INLINE update_ #-} +update_ v is w = update_stream v (Bundle.zipWith (,) (stream is) (stream w)) + +update_stream :: Vector v a => v a -> Bundle u (Int,a) -> v a +{-# INLINE update_stream #-} +update_stream = modifyWithBundle M.update + +-- | Same as ('//') but without bounds checking. +unsafeUpd :: Vector v a => v a -> [(Int, a)] -> v a +{-# INLINE unsafeUpd #-} +unsafeUpd v us = unsafeUpdate_stream v (Bundle.fromList us) + +-- | Same as 'update' but without bounds checking. +unsafeUpdate :: (Vector v a, Vector v (Int, a)) => v a -> v (Int, a) -> v a +{-# INLINE unsafeUpdate #-} +unsafeUpdate v w = unsafeUpdate_stream v (stream w) + +-- | Same as 'update_' but without bounds checking. +unsafeUpdate_ :: (Vector v a, Vector v Int) => v a -> v Int -> v a -> v a +{-# INLINE unsafeUpdate_ #-} +unsafeUpdate_ v is w + = unsafeUpdate_stream v (Bundle.zipWith (,) (stream is) (stream w)) + +unsafeUpdate_stream :: Vector v a => v a -> Bundle u (Int,a) -> v a +{-# INLINE unsafeUpdate_stream #-} +unsafeUpdate_stream = modifyWithBundle M.unsafeUpdate + +-- Accumulations +-- ------------- + +-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element +-- @a@ at position @i@ by @f a b@. +-- +-- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> +accum :: Vector v a + => (a -> b -> a) -- ^ accumulating function @f@ + -> v a -- ^ initial vector (of length @m@) + -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) + -> v a +{-# INLINE accum #-} +accum f v us = accum_stream f v (Bundle.fromList us) + +-- | /O(m+n)/ For each pair @(i,b)@ from the vector of pairs, replace the vector +-- element @a@ at position @i@ by @f a b@. +-- +-- > accumulate (+) <5,9,2> <(2,4),(1,6),(0,3),(1,7)> = <5+3, 9+6+7, 2+4> +accumulate :: (Vector v a, Vector v (Int, b)) + => (a -> b -> a) -- ^ accumulating function @f@ + -> v a -- ^ initial vector (of length @m@) + -> v (Int,b) -- ^ vector of index/value pairs (of length @n@) + -> v a +{-# INLINE accumulate #-} +accumulate f v us = accum_stream f v (stream us) + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the the value vector, +-- replace the element of the initial vector at +-- position @i@ by @f a b@. +-- +-- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> +-- +-- This function is useful for instances of 'Vector' that cannot store pairs. +-- Otherwise, 'accumulate' is probably more convenient: +-- +-- @ +-- accumulate_ f as is bs = 'accumulate' f as ('zip' is bs) +-- @ +accumulate_ :: (Vector v a, Vector v Int, Vector v b) + => (a -> b -> a) -- ^ accumulating function @f@ + -> v a -- ^ initial vector (of length @m@) + -> v Int -- ^ index vector (of length @n1@) + -> v b -- ^ value vector (of length @n2@) + -> v a +{-# INLINE accumulate_ #-} +accumulate_ f v is xs = accum_stream f v (Bundle.zipWith (,) (stream is) + (stream xs)) + + +accum_stream :: Vector v a => (a -> b -> a) -> v a -> Bundle u (Int,b) -> v a +{-# INLINE accum_stream #-} +accum_stream f = modifyWithBundle (M.accum f) + +-- | Same as 'accum' but without bounds checking. +unsafeAccum :: Vector v a => (a -> b -> a) -> v a -> [(Int,b)] -> v a +{-# INLINE unsafeAccum #-} +unsafeAccum f v us = unsafeAccum_stream f v (Bundle.fromList us) + +-- | Same as 'accumulate' but without bounds checking. +unsafeAccumulate :: (Vector v a, Vector v (Int, b)) + => (a -> b -> a) -> v a -> v (Int,b) -> v a +{-# INLINE unsafeAccumulate #-} +unsafeAccumulate f v us = unsafeAccum_stream f v (stream us) + +-- | Same as 'accumulate_' but without bounds checking. +unsafeAccumulate_ :: (Vector v a, Vector v Int, Vector v b) + => (a -> b -> a) -> v a -> v Int -> v b -> v a +{-# INLINE unsafeAccumulate_ #-} +unsafeAccumulate_ f v is xs + = unsafeAccum_stream f v (Bundle.zipWith (,) (stream is) (stream xs)) + +unsafeAccum_stream + :: Vector v a => (a -> b -> a) -> v a -> Bundle u (Int,b) -> v a +{-# INLINE unsafeAccum_stream #-} +unsafeAccum_stream f = modifyWithBundle (M.unsafeAccum f) + +-- Permutations +-- ------------ + +-- | /O(n)/ Reverse a vector +reverse :: (Vector v a) => v a -> v a +{-# INLINE reverse #-} +-- FIXME: make this fuse better, add support for recycling +reverse = unstream . streamR + +-- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the +-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is +-- often much more efficient. +-- +-- > backpermute <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a> +backpermute :: (Vector v a, Vector v Int) + => v a -- ^ @xs@ value vector + -> v Int -- ^ @is@ index vector (of length @n@) + -> v a +{-# INLINE backpermute #-} +-- This somewhat non-intuitive definition ensures that the resulting vector +-- does not retain references to the original one even if it is lazy in its +-- elements. This would not be the case if we simply used map (v!) +backpermute v is = seq v + $ seq n + $ unstream + $ Bundle.unbox + $ Bundle.map index + $ stream is + where + n = length v + + {-# INLINE index #-} + -- NOTE: we do it this way to avoid triggering LiberateCase on n in + -- polymorphic code + index i = BOUNDS_CHECK(checkIndex) "backpermute" i n + $ basicUnsafeIndexM v i + +-- | Same as 'backpermute' but without bounds checking. +unsafeBackpermute :: (Vector v a, Vector v Int) => v a -> v Int -> v a +{-# INLINE unsafeBackpermute #-} +unsafeBackpermute v is = seq v + $ seq n + $ unstream + $ Bundle.unbox + $ Bundle.map index + $ stream is + where + n = length v + + {-# INLINE index #-} + -- NOTE: we do it this way to avoid triggering LiberateCase on n in + -- polymorphic code + index i = UNSAFE_CHECK(checkIndex) "unsafeBackpermute" i n + $ basicUnsafeIndexM v i + +-- Safe destructive updates +-- ------------------------ + +-- | Apply a destructive operation to a vector. The operation will be +-- performed in place if it is safe to do so and will modify a copy of the +-- vector otherwise. +-- +-- @ +-- modify (\\v -> 'M.write' v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> +-- @ +modify :: Vector v a => (forall s. Mutable v s a -> ST s ()) -> v a -> v a +{-# INLINE modify #-} +modify p = new . New.modify p . clone + +-- We have to make sure that this is strict in the stream but we can't seq on +-- it while fusion is happening. Hence this ugliness. +modifyWithBundle :: Vector v a + => (forall s. Mutable v s a -> Bundle u b -> ST s ()) + -> v a -> Bundle u b -> v a +{-# INLINE modifyWithBundle #-} +modifyWithBundle p v s = new (New.modifyWithBundle p (clone v) s) + +-- Indexing +-- -------- + +-- | /O(n)/ Pair each element in a vector with its index +indexed :: (Vector v a, Vector v (Int,a)) => v a -> v (Int,a) +{-# INLINE indexed #-} +indexed = unstream . Bundle.indexed . stream + +-- Mapping +-- ------- + +-- | /O(n)/ Map a function over a vector +map :: (Vector v a, Vector v b) => (a -> b) -> v a -> v b +{-# INLINE map #-} +map f = unstream . inplace (S.map f) id . stream + +-- | /O(n)/ Apply a function to every element of a vector and its index +imap :: (Vector v a, Vector v b) => (Int -> a -> b) -> v a -> v b +{-# INLINE imap #-} +imap f = unstream . inplace (S.map (uncurry f) . S.indexed) id + . stream + +-- | Map a function over a vector and concatenate the results. +concatMap :: (Vector v a, Vector v b) => (a -> v b) -> v a -> v b +{-# INLINE concatMap #-} +-- NOTE: We can't fuse concatMap anyway so don't pretend we do. +-- This seems to be slightly slower +-- concatMap f = concat . Bundle.toList . Bundle.map f . stream + +-- Slowest +-- concatMap f = unstream . Bundle.concatMap (stream . f) . stream + +-- Used to be fastest +{- +concatMap f = unstream + . Bundle.flatten mk step Unknown + . stream + where + {-# INLINE_INNER step #-} + step (v,i,k) + | i < k = case unsafeIndexM v i of + Box x -> Bundle.Yield x (v,i+1,k) + | otherwise = Bundle.Done + + {-# INLINE mk #-} + mk x = let v = f x + k = length v + in + k `seq` (v,0,k) +-} + +-- This seems to be fastest now +concatMap f = unstream + . Bundle.concatVectors + . Bundle.map f + . stream + +-- Monadic mapping +-- --------------- + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results +mapM :: (Monad m, Vector v a, Vector v b) => (a -> m b) -> v a -> m (v b) +{-# INLINE mapM #-} +mapM f = unstreamM . Bundle.mapM f . stream + +-- | /O(n)/ Apply the monadic action to every element of a vector and its +-- index, yielding a vector of results +imapM :: (Monad m, Vector v a, Vector v b) + => (Int -> a -> m b) -> v a -> m (v b) +imapM f = unstreamM . Bundle.mapM (uncurry f) . Bundle.indexed . stream + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results +mapM_ :: (Monad m, Vector v a) => (a -> m b) -> v a -> m () +{-# INLINE mapM_ #-} +mapM_ f = Bundle.mapM_ f . stream + +-- | /O(n)/ Apply the monadic action to every element of a vector and its +-- index, ignoring the results +imapM_ :: (Monad m, Vector v a) => (Int -> a -> m b) -> v a -> m () +{-# INLINE imapM_ #-} +imapM_ f = Bundle.mapM_ (uncurry f) . Bundle.indexed . stream + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results. Equivalent to @flip 'mapM'@. +forM :: (Monad m, Vector v a, Vector v b) => v a -> (a -> m b) -> m (v b) +{-# INLINE forM #-} +forM as f = mapM f as + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results. Equivalent to @flip 'mapM_'@. +forM_ :: (Monad m, Vector v a) => v a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ as f = mapM_ f as + +-- Zipping +-- ------- + +-- | /O(min(m,n))/ Zip two vectors with the given function. +zipWith :: (Vector v a, Vector v b, Vector v c) + => (a -> b -> c) -> v a -> v b -> v c +{-# INLINE zipWith #-} +zipWith f = \xs ys -> unstream (Bundle.zipWith f (stream xs) (stream ys)) + +-- | Zip three vectors with the given function. +zipWith3 :: (Vector v a, Vector v b, Vector v c, Vector v d) + => (a -> b -> c -> d) -> v a -> v b -> v c -> v d +{-# INLINE zipWith3 #-} +zipWith3 f = \as bs cs -> unstream (Bundle.zipWith3 f (stream as) + (stream bs) + (stream cs)) + +zipWith4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e) + => (a -> b -> c -> d -> e) -> v a -> v b -> v c -> v d -> v e +{-# INLINE zipWith4 #-} +zipWith4 f = \as bs cs ds -> + unstream (Bundle.zipWith4 f (stream as) + (stream bs) + (stream cs) + (stream ds)) + +zipWith5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f) + => (a -> b -> c -> d -> e -> f) -> v a -> v b -> v c -> v d -> v e + -> v f +{-# INLINE zipWith5 #-} +zipWith5 f = \as bs cs ds es -> + unstream (Bundle.zipWith5 f (stream as) + (stream bs) + (stream cs) + (stream ds) + (stream es)) + +zipWith6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f, Vector v g) + => (a -> b -> c -> d -> e -> f -> g) + -> v a -> v b -> v c -> v d -> v e -> v f -> v g +{-# INLINE zipWith6 #-} +zipWith6 f = \as bs cs ds es fs -> + unstream (Bundle.zipWith6 f (stream as) + (stream bs) + (stream cs) + (stream ds) + (stream es) + (stream fs)) + +-- | /O(min(m,n))/ Zip two vectors with a function that also takes the +-- elements' indices. +izipWith :: (Vector v a, Vector v b, Vector v c) + => (Int -> a -> b -> c) -> v a -> v b -> v c +{-# INLINE izipWith #-} +izipWith f = \xs ys -> + unstream (Bundle.zipWith (uncurry f) (Bundle.indexed (stream xs)) + (stream ys)) + +izipWith3 :: (Vector v a, Vector v b, Vector v c, Vector v d) + => (Int -> a -> b -> c -> d) -> v a -> v b -> v c -> v d +{-# INLINE izipWith3 #-} +izipWith3 f = \as bs cs -> + unstream (Bundle.zipWith3 (uncurry f) (Bundle.indexed (stream as)) + (stream bs) + (stream cs)) + +izipWith4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e) + => (Int -> a -> b -> c -> d -> e) -> v a -> v b -> v c -> v d -> v e +{-# INLINE izipWith4 #-} +izipWith4 f = \as bs cs ds -> + unstream (Bundle.zipWith4 (uncurry f) (Bundle.indexed (stream as)) + (stream bs) + (stream cs) + (stream ds)) + +izipWith5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f) + => (Int -> a -> b -> c -> d -> e -> f) -> v a -> v b -> v c -> v d + -> v e -> v f +{-# INLINE izipWith5 #-} +izipWith5 f = \as bs cs ds es -> + unstream (Bundle.zipWith5 (uncurry f) (Bundle.indexed (stream as)) + (stream bs) + (stream cs) + (stream ds) + (stream es)) + +izipWith6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f, Vector v g) + => (Int -> a -> b -> c -> d -> e -> f -> g) + -> v a -> v b -> v c -> v d -> v e -> v f -> v g +{-# INLINE izipWith6 #-} +izipWith6 f = \as bs cs ds es fs -> + unstream (Bundle.zipWith6 (uncurry f) (Bundle.indexed (stream as)) + (stream bs) + (stream cs) + (stream ds) + (stream es) + (stream fs)) + +-- | /O(min(m,n))/ Zip two vectors +zip :: (Vector v a, Vector v b, Vector v (a,b)) => v a -> v b -> v (a, b) +{-# INLINE zip #-} +zip = zipWith (,) + +zip3 :: (Vector v a, Vector v b, Vector v c, Vector v (a, b, c)) + => v a -> v b -> v c -> v (a, b, c) +{-# INLINE zip3 #-} +zip3 = zipWith3 (,,) + +zip4 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v (a, b, c, d)) + => v a -> v b -> v c -> v d -> v (a, b, c, d) +{-# INLINE zip4 #-} +zip4 = zipWith4 (,,,) + +zip5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v (a, b, c, d, e)) + => v a -> v b -> v c -> v d -> v e -> v (a, b, c, d, e) +{-# INLINE zip5 #-} +zip5 = zipWith5 (,,,,) + +zip6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f, Vector v (a, b, c, d, e, f)) + => v a -> v b -> v c -> v d -> v e -> v f -> v (a, b, c, d, e, f) +{-# INLINE zip6 #-} +zip6 = zipWith6 (,,,,,) + +-- Monadic zipping +-- --------------- + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a +-- vector of results +zipWithM :: (Monad m, Vector v a, Vector v b, Vector v c) + => (a -> b -> m c) -> v a -> v b -> m (v c) +-- FIXME: specialise for ST and IO? +{-# INLINE zipWithM #-} +zipWithM f = \as bs -> unstreamM $ Bundle.zipWithM f (stream as) (stream bs) + +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes +-- the element index and yield a vector of results +izipWithM :: (Monad m, Vector v a, Vector v b, Vector v c) + => (Int -> a -> b -> m c) -> v a -> v b -> m (v c) +{-# INLINE izipWithM #-} +izipWithM m as bs = unstreamM . Bundle.zipWithM (uncurry m) + (Bundle.indexed (stream as)) + $ stream bs + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the +-- results +zipWithM_ :: (Monad m, Vector v a, Vector v b) + => (a -> b -> m c) -> v a -> v b -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ f = \as bs -> Bundle.zipWithM_ f (stream as) (stream bs) + +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes +-- the element index and ignore the results +izipWithM_ :: (Monad m, Vector v a, Vector v b) + => (Int -> a -> b -> m c) -> v a -> v b -> m () +{-# INLINE izipWithM_ #-} +izipWithM_ m as bs = Bundle.zipWithM_ (uncurry m) + (Bundle.indexed (stream as)) + $ stream bs + +-- Unzipping +-- --------- + +-- | /O(min(m,n))/ Unzip a vector of pairs. +unzip :: (Vector v a, Vector v b, Vector v (a,b)) => v (a, b) -> (v a, v b) +{-# INLINE unzip #-} +unzip xs = (map fst xs, map snd xs) + +unzip3 :: (Vector v a, Vector v b, Vector v c, Vector v (a, b, c)) + => v (a, b, c) -> (v a, v b, v c) +{-# INLINE unzip3 #-} +unzip3 xs = (map (\(a, _, _) -> a) xs, + map (\(_, b, _) -> b) xs, + map (\(_, _, c) -> c) xs) + +unzip4 :: (Vector v a, Vector v b, Vector v c, Vector v d, + Vector v (a, b, c, d)) + => v (a, b, c, d) -> (v a, v b, v c, v d) +{-# INLINE unzip4 #-} +unzip4 xs = (map (\(a, _, _, _) -> a) xs, + map (\(_, b, _, _) -> b) xs, + map (\(_, _, c, _) -> c) xs, + map (\(_, _, _, d) -> d) xs) + +unzip5 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v (a, b, c, d, e)) + => v (a, b, c, d, e) -> (v a, v b, v c, v d, v e) +{-# INLINE unzip5 #-} +unzip5 xs = (map (\(a, _, _, _, _) -> a) xs, + map (\(_, b, _, _, _) -> b) xs, + map (\(_, _, c, _, _) -> c) xs, + map (\(_, _, _, d, _) -> d) xs, + map (\(_, _, _, _, e) -> e) xs) + +unzip6 :: (Vector v a, Vector v b, Vector v c, Vector v d, Vector v e, + Vector v f, Vector v (a, b, c, d, e, f)) + => v (a, b, c, d, e, f) -> (v a, v b, v c, v d, v e, v f) +{-# INLINE unzip6 #-} +unzip6 xs = (map (\(a, _, _, _, _, _) -> a) xs, + map (\(_, b, _, _, _, _) -> b) xs, + map (\(_, _, c, _, _, _) -> c) xs, + map (\(_, _, _, d, _, _) -> d) xs, + map (\(_, _, _, _, e, _) -> e) xs, + map (\(_, _, _, _, _, f) -> f) xs) + +-- Filtering +-- --------- + +-- | /O(n)/ Drop elements that do not satisfy the predicate +filter :: Vector v a => (a -> Bool) -> v a -> v a +{-# INLINE filter #-} +filter f = unstream . inplace (S.filter f) toMax . stream + +-- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to +-- values and their indices +ifilter :: Vector v a => (Int -> a -> Bool) -> v a -> v a +{-# INLINE ifilter #-} +ifilter f = unstream + . inplace (S.map snd . S.filter (uncurry f) . S.indexed) toMax + . stream + +-- | /O(n)/ Drop repeated adjacent elements. +uniq :: (Vector v a, Eq a) => v a -> v a +{-# INLINE uniq #-} +uniq = unstream . inplace S.uniq toMax . stream + +-- | /O(n)/ Drop elements when predicate returns Nothing +mapMaybe :: (Vector v a, Vector v b) => (a -> Maybe b) -> v a -> v b +{-# INLINE mapMaybe #-} +mapMaybe f = unstream . inplace (S.mapMaybe f) toMax . stream + +-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing +imapMaybe :: (Vector v a, Vector v b) => (Int -> a -> Maybe b) -> v a -> v b +{-# INLINE imapMaybe #-} +imapMaybe f = unstream + . inplace (S.mapMaybe (uncurry f) . S.indexed) toMax + . stream + + +-- | /O(n)/ Drop elements that do not satisfy the monadic predicate +filterM :: (Monad m, Vector v a) => (a -> m Bool) -> v a -> m (v a) +{-# INLINE filterM #-} +filterM f = unstreamM . Bundle.filterM f . stream + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate +-- without copying. +takeWhile :: Vector v a => (a -> Bool) -> v a -> v a +{-# INLINE takeWhile #-} +takeWhile f = unstream . Bundle.takeWhile f . stream + +-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate +-- without copying. +dropWhile :: Vector v a => (a -> Bool) -> v a -> v a +{-# INLINE dropWhile #-} +dropWhile f = unstream . Bundle.dropWhile f . stream + +-- Parititioning +-- ------------- + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. The +-- relative order of the elements is preserved at the cost of a sometimes +-- reduced performance compared to 'unstablePartition'. +partition :: Vector v a => (a -> Bool) -> v a -> (v a, v a) +{-# INLINE partition #-} +partition f = partition_stream f . stream + +-- FIXME: Make this inplace-fusible (look at how stable_partition is +-- implemented in C++) + +partition_stream :: Vector v a => (a -> Bool) -> Bundle u a -> (v a, v a) +{-# INLINE_FUSED partition_stream #-} +partition_stream f s = s `seq` runST ( + do + (mv1,mv2) <- M.partitionBundle f s + v1 <- unsafeFreeze mv1 + v2 <- unsafeFreeze mv2 + return (v1,v2)) + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. +-- The order of the elements is not preserved but the operation is often +-- faster than 'partition'. +unstablePartition :: Vector v a => (a -> Bool) -> v a -> (v a, v a) +{-# INLINE unstablePartition #-} +unstablePartition f = unstablePartition_stream f . stream + +unstablePartition_stream + :: Vector v a => (a -> Bool) -> Bundle u a -> (v a, v a) +{-# INLINE_FUSED unstablePartition_stream #-} +unstablePartition_stream f s = s `seq` runST ( + do + (mv1,mv2) <- M.unstablePartitionBundle f s + v1 <- unsafeFreeze mv1 + v2 <- unsafeFreeze mv2 + return (v1,v2)) + +unstablePartition_new :: Vector v a => (a -> Bool) -> New v a -> (v a, v a) +{-# INLINE_FUSED unstablePartition_new #-} +unstablePartition_new f (New.New p) = runST ( + do + mv <- p + i <- M.unstablePartition f mv + v <- unsafeFreeze mv + return (unsafeTake i v, unsafeDrop i v)) + +{-# RULES + +"unstablePartition" forall f p. + unstablePartition_stream f (stream (new p)) + = unstablePartition_new f p #-} + + + + +-- FIXME: make span and break fusible + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +span :: Vector v a => (a -> Bool) -> v a -> (v a, v a) +{-# INLINE span #-} +span f = break (not . f) + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +break :: Vector v a => (a -> Bool) -> v a -> (v a, v a) +{-# INLINE break #-} +break f xs = case findIndex f xs of + Just i -> (unsafeSlice 0 i xs, unsafeSlice i (length xs - i) xs) + Nothing -> (xs, empty) + + +-- Searching +-- --------- + +infix 4 `elem` +-- | /O(n)/ Check if the vector contains an element +elem :: (Vector v a, Eq a) => a -> v a -> Bool +{-# INLINE elem #-} +elem x = Bundle.elem x . stream + +infix 4 `notElem` +-- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') +notElem :: (Vector v a, Eq a) => a -> v a -> Bool +{-# INLINE notElem #-} +notElem x = Bundle.notElem x . stream + +-- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' +-- if no such element exists. +find :: Vector v a => (a -> Bool) -> v a -> Maybe a +{-# INLINE find #-} +find f = Bundle.find f . stream + +-- | /O(n)/ Yield 'Just' the index of the first element matching the predicate +-- or 'Nothing' if no such element exists. +findIndex :: Vector v a => (a -> Bool) -> v a -> Maybe Int +{-# INLINE findIndex #-} +findIndex f = Bundle.findIndex f . stream + +-- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending +-- order. +findIndices :: (Vector v a, Vector v Int) => (a -> Bool) -> v a -> v Int +{-# INLINE findIndices #-} +findIndices f = unstream + . inplace (S.map fst . S.filter (f . snd) . S.indexed) toMax + . stream + +-- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or +-- 'Nothing' if the vector does not contain the element. This is a specialised +-- version of 'findIndex'. +elemIndex :: (Vector v a, Eq a) => a -> v a -> Maybe Int +{-# INLINE elemIndex #-} +elemIndex x = findIndex (x==) + +-- | /O(n)/ Yield the indices of all occurences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +elemIndices :: (Vector v a, Vector v Int, Eq a) => a -> v a -> v Int +{-# INLINE elemIndices #-} +elemIndices x = findIndices (x==) + +-- Folding +-- ------- + +-- | /O(n)/ Left fold +foldl :: Vector v b => (a -> b -> a) -> a -> v b -> a +{-# INLINE foldl #-} +foldl f z = Bundle.foldl f z . stream + +-- | /O(n)/ Left fold on non-empty vectors +foldl1 :: Vector v a => (a -> a -> a) -> v a -> a +{-# INLINE foldl1 #-} +foldl1 f = Bundle.foldl1 f . stream + +-- | /O(n)/ Left fold with strict accumulator +foldl' :: Vector v b => (a -> b -> a) -> a -> v b -> a +{-# INLINE foldl' #-} +foldl' f z = Bundle.foldl' f z . stream + +-- | /O(n)/ Left fold on non-empty vectors with strict accumulator +foldl1' :: Vector v a => (a -> a -> a) -> v a -> a +{-# INLINE foldl1' #-} +foldl1' f = Bundle.foldl1' f . stream + +-- | /O(n)/ Right fold +foldr :: Vector v a => (a -> b -> b) -> b -> v a -> b +{-# INLINE foldr #-} +foldr f z = Bundle.foldr f z . stream + +-- | /O(n)/ Right fold on non-empty vectors +foldr1 :: Vector v a => (a -> a -> a) -> v a -> a +{-# INLINE foldr1 #-} +foldr1 f = Bundle.foldr1 f . stream + +-- | /O(n)/ Right fold with a strict accumulator +foldr' :: Vector v a => (a -> b -> b) -> b -> v a -> b +{-# INLINE foldr' #-} +foldr' f z = Bundle.foldl' (flip f) z . streamR + +-- | /O(n)/ Right fold on non-empty vectors with strict accumulator +foldr1' :: Vector v a => (a -> a -> a) -> v a -> a +{-# INLINE foldr1' #-} +foldr1' f = Bundle.foldl1' (flip f) . streamR + +-- | /O(n)/ Left fold (function applied to each element and its index) +ifoldl :: Vector v b => (a -> Int -> b -> a) -> a -> v b -> a +{-# INLINE ifoldl #-} +ifoldl f z = Bundle.foldl (uncurry . f) z . Bundle.indexed . stream + +-- | /O(n)/ Left fold with strict accumulator (function applied to each element +-- and its index) +ifoldl' :: Vector v b => (a -> Int -> b -> a) -> a -> v b -> a +{-# INLINE ifoldl' #-} +ifoldl' f z = Bundle.foldl' (uncurry . f) z . Bundle.indexed . stream + +-- | /O(n)/ Right fold (function applied to each element and its index) +ifoldr :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b +{-# INLINE ifoldr #-} +ifoldr f z = Bundle.foldr (uncurry f) z . Bundle.indexed . stream + +-- | /O(n)/ Right fold with strict accumulator (function applied to each +-- element and its index) +ifoldr' :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b +{-# INLINE ifoldr' #-} +ifoldr' f z xs = Bundle.foldl' (flip (uncurry f)) z + $ Bundle.indexedR (length xs) $ streamR xs + +-- Specialised folds +-- ----------------- + +-- | /O(n)/ Check if all elements satisfy the predicate. +all :: Vector v a => (a -> Bool) -> v a -> Bool +{-# INLINE all #-} +all f = Bundle.and . Bundle.map f . stream + +-- | /O(n)/ Check if any element satisfies the predicate. +any :: Vector v a => (a -> Bool) -> v a -> Bool +{-# INLINE any #-} +any f = Bundle.or . Bundle.map f . stream + +-- | /O(n)/ Check if all elements are 'True' +and :: Vector v Bool => v Bool -> Bool +{-# INLINE and #-} +and = Bundle.and . stream + +-- | /O(n)/ Check if any element is 'True' +or :: Vector v Bool => v Bool -> Bool +{-# INLINE or #-} +or = Bundle.or . stream + +-- | /O(n)/ Compute the sum of the elements +sum :: (Vector v a, Num a) => v a -> a +{-# INLINE sum #-} +sum = Bundle.foldl' (+) 0 . stream + +-- | /O(n)/ Compute the produce of the elements +product :: (Vector v a, Num a) => v a -> a +{-# INLINE product #-} +product = Bundle.foldl' (*) 1 . stream + +-- | /O(n)/ Yield the maximum element of the vector. The vector may not be +-- empty. +maximum :: (Vector v a, Ord a) => v a -> a +{-# INLINE maximum #-} +maximum = Bundle.foldl1' max . stream + +-- | /O(n)/ Yield the maximum element of the vector according to the given +-- comparison function. The vector may not be empty. +maximumBy :: Vector v a => (a -> a -> Ordering) -> v a -> a +{-# INLINE maximumBy #-} +maximumBy cmpr = Bundle.foldl1' maxBy . stream + where + {-# INLINE maxBy #-} + maxBy x y = case cmpr x y of + LT -> y + _ -> x + +-- | /O(n)/ Yield the minimum element of the vector. The vector may not be +-- empty. +minimum :: (Vector v a, Ord a) => v a -> a +{-# INLINE minimum #-} +minimum = Bundle.foldl1' min . stream + +-- | /O(n)/ Yield the minimum element of the vector according to the given +-- comparison function. The vector may not be empty. +minimumBy :: Vector v a => (a -> a -> Ordering) -> v a -> a +{-# INLINE minimumBy #-} +minimumBy cmpr = Bundle.foldl1' minBy . stream + where + {-# INLINE minBy #-} + minBy x y = case cmpr x y of + GT -> y + _ -> x + +-- | /O(n)/ Yield the index of the maximum element of the vector. The vector +-- may not be empty. +maxIndex :: (Vector v a, Ord a) => v a -> Int +{-# INLINE maxIndex #-} +maxIndex = maxIndexBy compare + +-- | /O(n)/ Yield the index of the maximum element of the vector according to +-- the given comparison function. The vector may not be empty. +maxIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int +{-# INLINE maxIndexBy #-} +maxIndexBy cmpr = fst . Bundle.foldl1' imax . Bundle.indexed . stream + where + imax (i,x) (j,y) = i `seq` j `seq` + case cmpr x y of + LT -> (j,y) + _ -> (i,x) + +-- | /O(n)/ Yield the index of the minimum element of the vector. The vector +-- may not be empty. +minIndex :: (Vector v a, Ord a) => v a -> Int +{-# INLINE minIndex #-} +minIndex = minIndexBy compare + +-- | /O(n)/ Yield the index of the minimum element of the vector according to +-- the given comparison function. The vector may not be empty. +minIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int +{-# INLINE minIndexBy #-} +minIndexBy cmpr = fst . Bundle.foldl1' imin . Bundle.indexed . stream + where + imin (i,x) (j,y) = i `seq` j `seq` + case cmpr x y of + GT -> (j,y) + _ -> (i,x) + +-- Monadic folds +-- ------------- + +-- | /O(n)/ Monadic fold +foldM :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a +{-# INLINE foldM #-} +foldM m z = Bundle.foldM m z . stream + +-- | /O(n)/ Monadic fold (action applied to each element and its index) +ifoldM :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m a +{-# INLINE ifoldM #-} +ifoldM m z = Bundle.foldM (uncurry . m) z . Bundle.indexed . stream + +-- | /O(n)/ Monadic fold over non-empty vectors +fold1M :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m a +{-# INLINE fold1M #-} +fold1M m = Bundle.fold1M m . stream + +-- | /O(n)/ Monadic fold with strict accumulator +foldM' :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a +{-# INLINE foldM' #-} +foldM' m z = Bundle.foldM' m z . stream + +-- | /O(n)/ Monadic fold with strict accumulator (action applied to each +-- element and its index) +ifoldM' :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m a +{-# INLINE ifoldM' #-} +ifoldM' m z = Bundle.foldM' (uncurry . m) z . Bundle.indexed . stream + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +fold1M' :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m a +{-# INLINE fold1M' #-} +fold1M' m = Bundle.fold1M' m . stream + +discard :: Monad m => m a -> m () +{-# INLINE discard #-} +discard m = m >> return () + +-- | /O(n)/ Monadic fold that discards the result +foldM_ :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m () +{-# INLINE foldM_ #-} +foldM_ m z = discard . Bundle.foldM m z . stream + +-- | /O(n)/ Monadic fold that discards the result (action applied to +-- each element and its index) +ifoldM_ :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m () +{-# INLINE ifoldM_ #-} +ifoldM_ m z = discard . Bundle.foldM (uncurry . m) z . Bundle.indexed . stream + +-- | /O(n)/ Monadic fold over non-empty vectors that discards the result +fold1M_ :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m () +{-# INLINE fold1M_ #-} +fold1M_ m = discard . Bundle.fold1M m . stream + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +foldM'_ :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m () +{-# INLINE foldM'_ #-} +foldM'_ m z = discard . Bundle.foldM' m z . stream + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +-- (action applied to each element and its index) +ifoldM'_ :: (Monad m, Vector v b) => (a -> Int -> b -> m a) -> a -> v b -> m () +{-# INLINE ifoldM'_ #-} +ifoldM'_ m z = discard . Bundle.foldM' (uncurry . m) z . Bundle.indexed . stream + +-- | /O(n)/ Monad fold over non-empty vectors with strict accumulator +-- that discards the result +fold1M'_ :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ m = discard . Bundle.fold1M' m . stream + +-- Monadic sequencing +-- ------------------ + +-- | Evaluate each action and collect the results +sequence :: (Monad m, Vector v a, Vector v (m a)) => v (m a) -> m (v a) +{-# INLINE sequence #-} +sequence = mapM id + +-- | Evaluate each action and discard the results +sequence_ :: (Monad m, Vector v (m a)) => v (m a) -> m () +{-# INLINE sequence_ #-} +sequence_ = mapM_ id + +-- Prefix sums (scans) +-- ------------------- + +-- | /O(n)/ Prescan +-- +-- @ +-- prescanl f z = 'init' . 'scanl' f z +-- @ +-- +-- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ +-- +prescanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a +{-# INLINE prescanl #-} +prescanl f z = unstream . inplace (S.prescanl f z) id . stream + +-- | /O(n)/ Prescan with strict accumulator +prescanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a +{-# INLINE prescanl' #-} +prescanl' f z = unstream . inplace (S.prescanl' f z) id . stream + +-- | /O(n)/ Scan +-- +-- @ +-- postscanl f z = 'tail' . 'scanl' f z +-- @ +-- +-- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ +-- +postscanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a +{-# INLINE postscanl #-} +postscanl f z = unstream . inplace (S.postscanl f z) id . stream + +-- | /O(n)/ Scan with strict accumulator +postscanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a +{-# INLINE postscanl' #-} +postscanl' f z = unstream . inplace (S.postscanl' f z) id . stream + +-- | /O(n)/ Haskell-style scan +-- +-- > scanl f z <x1,...,xn> = <y1,...,y(n+1)> +-- > where y1 = z +-- > yi = f y(i-1) x(i-1) +-- +-- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@ +-- +scanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a +{-# INLINE scanl #-} +scanl f z = unstream . Bundle.scanl f z . stream + +-- | /O(n)/ Haskell-style scan with strict accumulator +scanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a +{-# INLINE scanl' #-} +scanl' f z = unstream . Bundle.scanl' f z . stream + +-- | /O(n)/ Scan over a vector with its index +iscanl :: (Vector v a, Vector v b) => (Int -> a -> b -> a) -> a -> v b -> v a +{-# INLINE iscanl #-} +iscanl f z = + unstream + . inplace (S.scanl (\a (i, b) -> f i a b) z . S.indexed) (+1) + . stream + +-- | /O(n)/ Scan over a vector (strictly) with its index +iscanl' :: (Vector v a, Vector v b) => (Int -> a -> b -> a) -> a -> v b -> v a +{-# INLINE iscanl' #-} +iscanl' f z = + unstream + . inplace (S.scanl' (\a (i, b) -> f i a b) z . S.indexed) (+1) + . stream + + +-- | /O(n)/ Scan over a non-empty vector +-- +-- > scanl f <x1,...,xn> = <y1,...,yn> +-- > where y1 = x1 +-- > yi = f y(i-1) xi +-- +scanl1 :: Vector v a => (a -> a -> a) -> v a -> v a +{-# INLINE scanl1 #-} +scanl1 f = unstream . inplace (S.scanl1 f) id . stream + +-- | /O(n)/ Scan over a non-empty vector with a strict accumulator +scanl1' :: Vector v a => (a -> a -> a) -> v a -> v a +{-# INLINE scanl1' #-} +scanl1' f = unstream . inplace (S.scanl1' f) id . stream + +-- | /O(n)/ Right-to-left prescan +-- +-- @ +-- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' +-- @ +-- +prescanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b +{-# INLINE prescanr #-} +prescanr f z = unstreamR . inplace (S.prescanl (flip f) z) id . streamR + +-- | /O(n)/ Right-to-left prescan with strict accumulator +prescanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b +{-# INLINE prescanr' #-} +prescanr' f z = unstreamR . inplace (S.prescanl' (flip f) z) id . streamR + +-- | /O(n)/ Right-to-left scan +postscanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b +{-# INLINE postscanr #-} +postscanr f z = unstreamR . inplace (S.postscanl (flip f) z) id . streamR + +-- | /O(n)/ Right-to-left scan with strict accumulator +postscanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b +{-# INLINE postscanr' #-} +postscanr' f z = unstreamR . inplace (S.postscanl' (flip f) z) id . streamR + +-- | /O(n)/ Right-to-left Haskell-style scan +scanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b +{-# INLINE scanr #-} +scanr f z = unstreamR . Bundle.scanl (flip f) z . streamR + +-- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator +scanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b +{-# INLINE scanr' #-} +scanr' f z = unstreamR . Bundle.scanl' (flip f) z . streamR + +-- | /O(n)/ Right-to-left scan over a vector with its index +iscanr :: (Vector v a, Vector v b) => (Int -> a -> b -> b) -> b -> v a -> v b +{-# INLINE iscanr #-} +iscanr f z v = + unstreamR + . inplace (S.scanl (flip $ uncurry f) z . S.indexedR n) (+1) + . streamR + $ v + where n = length v + +-- | /O(n)/ Right-to-left scan over a vector (strictly) with its index +iscanr' :: (Vector v a, Vector v b) => (Int -> a -> b -> b) -> b -> v a -> v b +{-# INLINE iscanr' #-} +iscanr' f z v = + unstreamR + . inplace (S.scanl' (flip $ uncurry f) z . S.indexedR n) (+1) + . streamR + $ v + where n = length v + +-- | /O(n)/ Right-to-left scan over a non-empty vector +scanr1 :: Vector v a => (a -> a -> a) -> v a -> v a +{-# INLINE scanr1 #-} +scanr1 f = unstreamR . inplace (S.scanl1 (flip f)) id . streamR + +-- | /O(n)/ Right-to-left scan over a non-empty vector with a strict +-- accumulator +scanr1' :: Vector v a => (a -> a -> a) -> v a -> v a +{-# INLINE scanr1' #-} +scanr1' f = unstreamR . inplace (S.scanl1' (flip f)) id . streamR + +-- Conversions - Lists +-- ------------------------ + +-- | /O(n)/ Convert a vector to a list +toList :: Vector v a => v a -> [a] +{-# INLINE toList #-} +toList = Bundle.toList . stream + +-- | /O(n)/ Convert a list to a vector +fromList :: Vector v a => [a] -> v a +{-# INLINE fromList #-} +fromList = unstream . Bundle.fromList + +-- | /O(n)/ Convert the first @n@ elements of a list to a vector +-- +-- @ +-- fromListN n xs = 'fromList' ('take' n xs) +-- @ +fromListN :: Vector v a => Int -> [a] -> v a +{-# INLINE fromListN #-} +fromListN n = unstream . Bundle.fromListN n + +-- Conversions - Immutable vectors +-- ------------------------------- + +-- | /O(n)/ Convert different vector types +convert :: (Vector v a, Vector w a) => v a -> w a +{-# INLINE convert #-} +convert = unstream . Bundle.reVector . stream + +-- Conversions - Mutable vectors +-- ----------------------------- + +-- | /O(1)/ Unsafe convert a mutable vector to an immutable one without +-- copying. The mutable vector may not be used after this operation. +unsafeFreeze + :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m (v a) +{-# INLINE unsafeFreeze #-} +unsafeFreeze = basicUnsafeFreeze + +-- | /O(n)/ Yield an immutable copy of the mutable vector. +freeze :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m (v a) +{-# INLINE freeze #-} +freeze mv = unsafeFreeze =<< M.clone mv + +-- | /O(1)/ Unsafely convert an immutable vector to a mutable one without +-- copying. The immutable vector may not be used after this operation. +unsafeThaw :: (PrimMonad m, Vector v a) => v a -> m (Mutable v (PrimState m) a) +{-# INLINE_FUSED unsafeThaw #-} +unsafeThaw = basicUnsafeThaw + +-- | /O(n)/ Yield a mutable copy of the immutable vector. +thaw :: (PrimMonad m, Vector v a) => v a -> m (Mutable v (PrimState m) a) +{-# INLINE_FUSED thaw #-} +thaw v = do + mv <- M.unsafeNew (length v) + unsafeCopy mv v + return mv + +{-# RULES + +"unsafeThaw/new [Vector]" forall p. + unsafeThaw (new p) = New.runPrim p + +"thaw/new [Vector]" forall p. + thaw (new p) = New.runPrim p #-} + + + +{- +-- | /O(n)/ Yield a mutable vector containing copies of each vector in the +-- list. +thawMany :: (PrimMonad m, Vector v a) => [v a] -> m (Mutable v (PrimState m) a) +{-# INLINE_FUSED thawMany #-} +-- FIXME: add rule for (stream (new (New.create (thawMany vs)))) +-- NOTE: We don't try to consume the list lazily as this wouldn't significantly +-- change the space requirements anyway. +thawMany vs = do + mv <- M.new n + thaw_loop mv vs + return mv + where + n = List.foldl' (\k v -> k + length v) 0 vs + + thaw_loop mv [] = mv `seq` return () + thaw_loop mv (v:vs) + = do + let n = length v + unsafeCopy (M.unsafeTake n mv) v + thaw_loop (M.unsafeDrop n mv) vs +-} + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. +copy + :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> v a -> m () +{-# INLINE copy #-} +copy dst src = BOUNDS_CHECK(check) "copy" "length mismatch" + (M.length dst == length src) + $ unsafeCopy dst src + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. This is not checked. +unsafeCopy + :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> v a -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy dst src = UNSAFE_CHECK(check) "unsafeCopy" "length mismatch" + (M.length dst == length src) + $ (dst `seq` src `seq` basicUnsafeCopy dst src) + +-- Conversions to/from Bundles +-- --------------------------- + +-- | /O(1)/ Convert a vector to a 'Bundle' +stream :: Vector v a => v a -> Bundle v a +{-# INLINE_FUSED stream #-} +stream v = stream' v + +-- Same as 'stream', but can be used to avoid having a cycle in the dependency +-- graph of functions, which forces GHC to create a loop breaker. +stream' :: Vector v a => v a -> Bundle v a +{-# INLINE stream' #-} +stream' v = Bundle.fromVector v + +{- +stream v = v `seq` n `seq` (Bundle.unfoldr get 0 `Bundle.sized` Exact n) + where + n = length v + + -- NOTE: the False case comes first in Core so making it the recursive one + -- makes the code easier to read + {-# INLINE get #-} + get i | i >= n = Nothing + | otherwise = case basicUnsafeIndexM v i of Box x -> Just (x, i+1) +-} + +-- | /O(n)/ Construct a vector from a 'Bundle' +unstream :: Vector v a => Bundle v a -> v a +{-# INLINE unstream #-} +unstream s = new (New.unstream s) + +{-# RULES + +"stream/unstream [Vector]" forall s. + stream (new (New.unstream s)) = s + +"New.unstream/stream [Vector]" forall v. + New.unstream (stream v) = clone v + +"clone/new [Vector]" forall p. + clone (new p) = p + +"inplace [Vector]" + forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m. + New.unstream (inplace f g (stream (new m))) = New.transform f g m + +"uninplace [Vector]" + forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m. + stream (new (New.transform f g m)) = inplace f g (stream (new m)) #-} + + + +-- | /O(1)/ Convert a vector to a 'Bundle', proceeding from right to left +streamR :: Vector v a => v a -> Bundle u a +{-# INLINE_FUSED streamR #-} +streamR v = v `seq` n `seq` (Bundle.unfoldr get n `Bundle.sized` Exact n) + where + n = length v + + {-# INLINE get #-} + get 0 = Nothing + get i = let i' = i-1 + in + case basicUnsafeIndexM v i' of Box x -> Just (x, i') + +-- | /O(n)/ Construct a vector from a 'Bundle', proceeding from right to left +unstreamR :: Vector v a => Bundle v a -> v a +{-# INLINE unstreamR #-} +unstreamR s = new (New.unstreamR s) + +{-# RULES + +"streamR/unstreamR [Vector]" forall s. + streamR (new (New.unstreamR s)) = s + +"New.unstreamR/streamR/new [Vector]" forall p. + New.unstreamR (streamR (new p)) = p + +"New.unstream/streamR/new [Vector]" forall p. + New.unstream (streamR (new p)) = New.modify M.reverse p + +"New.unstreamR/stream/new [Vector]" forall p. + New.unstreamR (stream (new p)) = New.modify M.reverse p + +"inplace right [Vector]" + forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m. + New.unstreamR (inplace f g (streamR (new m))) = New.transformR f g m + +"uninplace right [Vector]" + forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m. + streamR (new (New.transformR f g m)) = inplace f g (streamR (new m)) #-} + + + +unstreamM :: (Monad m, Vector v a) => MBundle m u a -> m (v a) +{-# INLINE_FUSED unstreamM #-} +unstreamM s = do + xs <- MBundle.toList s + return $ unstream $ Bundle.unsafeFromList (MBundle.size s) xs + +unstreamPrimM :: (PrimMonad m, Vector v a) => MBundle m u a -> m (v a) +{-# INLINE_FUSED unstreamPrimM #-} +unstreamPrimM s = M.munstream s >>= unsafeFreeze + +-- FIXME: the next two functions are only necessary for the specialisations +unstreamPrimM_IO :: Vector v a => MBundle IO u a -> IO (v a) +{-# INLINE unstreamPrimM_IO #-} +unstreamPrimM_IO = unstreamPrimM + +unstreamPrimM_ST :: Vector v a => MBundle (ST s) u a -> ST s (v a) +{-# INLINE unstreamPrimM_ST #-} +unstreamPrimM_ST = unstreamPrimM + +{-# RULES + +"unstreamM[IO]" unstreamM = unstreamPrimM_IO +"unstreamM[ST]" unstreamM = unstreamPrimM_ST #-} + + + + +-- Recycling support +-- ----------------- + +-- | Construct a vector from a monadic initialiser. +new :: Vector v a => New v a -> v a +{-# INLINE_FUSED new #-} +new m = m `seq` runST (unsafeFreeze =<< New.run m) + +-- | Convert a vector to an initialiser which, when run, produces a copy of +-- the vector. +clone :: Vector v a => v a -> New v a +{-# INLINE_FUSED clone #-} +clone v = v `seq` New.create ( + do + mv <- M.new (length v) + unsafeCopy mv v + return mv) + +-- Comparisons +-- ----------- + +-- | /O(n)/ Check if two vectors are equal. All 'Vector' instances are also +-- instances of 'Eq' and it is usually more appropriate to use those. This +-- function is primarily intended for implementing 'Eq' instances for new +-- vector types. +eq :: (Vector v a, Eq a) => v a -> v a -> Bool +{-# INLINE eq #-} +xs `eq` ys = stream xs == stream ys + +-- | /O(n)/ +eqBy :: (Vector v a, Vector v b) => (a -> b -> Bool) -> v a -> v b -> Bool +{-# INLINE eqBy #-} +eqBy e xs ys = Bundle.eqBy e (stream xs) (stream ys) + +-- | /O(n)/ Compare two vectors lexicographically. All 'Vector' instances are +-- also instances of 'Ord' and it is usually more appropriate to use those. This +-- function is primarily intended for implementing 'Ord' instances for new +-- vector types. +cmp :: (Vector v a, Ord a) => v a -> v a -> Ordering +{-# INLINE cmp #-} +cmp xs ys = compare (stream xs) (stream ys) + +-- | /O(n)/ +cmpBy :: (Vector v a, Vector v b) => (a -> b -> Ordering) -> v a -> v b -> Ordering +cmpBy c xs ys = Bundle.cmpBy c (stream xs) (stream ys) + +-- Show +-- ---- + +-- | Generic definition of 'Prelude.showsPrec' +showsPrec :: (Vector v a, Show a) => Int -> v a -> ShowS +{-# INLINE showsPrec #-} +showsPrec _ = shows . toList + +liftShowsPrec :: (Vector v a) => (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> v a -> ShowS +{-# INLINE liftShowsPrec #-} +liftShowsPrec _ s _ = s . toList + +-- | Generic definition of 'Text.Read.readPrec' +readPrec :: (Vector v a, Read a) => Read.ReadPrec (v a) +{-# INLINE readPrec #-} +readPrec = do + xs <- Read.readPrec + return (fromList xs) + +-- | /Note:/ uses 'ReadS' +liftReadsPrec :: (Vector v a) => (Int -> Read.ReadS a) -> ReadS [a] -> Int -> Read.ReadS (v a) +liftReadsPrec _ r _ s = [ (fromList v, s') | (v, s') <- r s ] + +-- Data and Typeable +-- ----------------- + +-- | Generic definion of 'Data.Data.gfoldl' that views a 'Vector' as a +-- list. +gfoldl :: (Vector v a, Data a) + => (forall d b. Data d => c (d -> b) -> d -> c b) + -> (forall g. g -> c g) + -> v a + -> c (v a) +{-# INLINE gfoldl #-} +gfoldl f z v = z fromList `f` toList v + +mkType :: String -> DataType +{-# INLINE mkType #-} +mkType = mkNoRepType + +#if __GLASGOW_HASKELL__ >= 707 +dataCast :: (Vector v a, Data a, Typeable v, Typeable t) +#else +dataCast :: (Vector v a, Data a, Typeable1 v, Typeable1 t) +#endif + => (forall d. Data d => c (t d)) -> Maybe (c (v a)) +{-# INLINE dataCast #-} +dataCast f = gcast1 f diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Base.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Base.hs new file mode 100644 index 0000000000..a760329c59 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Base.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleContexts, + TypeFamilies, ScopedTypeVariables, BangPatterns #-} +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Module : Data.Vector.Generic.Base +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Class of pure vectors +-- + +module Data.Vector.Generic.Base ( + Vector(..), Mutable +) where + +import Data.Vector.Generic.Mutable.Base ( MVector ) +import qualified Data.Vector.Generic.Mutable.Base as M + +import Control.Monad.Primitive + +-- | @Mutable v s a@ is the mutable version of the pure vector type @v a@ with +-- the state token @s@ +-- +type family Mutable (v :: * -> *) :: * -> * -> * + +-- | Class of immutable vectors. Every immutable vector is associated with its +-- mutable version through the 'Mutable' type family. Methods of this class +-- should not be used directly. Instead, "Data.Vector.Generic" and other +-- Data.Vector modules provide safe and fusible wrappers. +-- +-- Minimum complete implementation: +-- +-- * 'basicUnsafeFreeze' +-- +-- * 'basicUnsafeThaw' +-- +-- * 'basicLength' +-- +-- * 'basicUnsafeSlice' +-- +-- * 'basicUnsafeIndexM' +-- +class MVector (Mutable v) a => Vector v a where + -- | /Assumed complexity: O(1)/ + -- + -- Unsafely convert a mutable vector to its immutable version + -- without copying. The mutable vector may not be used after + -- this operation. + basicUnsafeFreeze :: PrimMonad m => Mutable v (PrimState m) a -> m (v a) + + -- | /Assumed complexity: O(1)/ + -- + -- Unsafely convert an immutable vector to its mutable version without + -- copying. The immutable vector may not be used after this operation. + basicUnsafeThaw :: PrimMonad m => v a -> m (Mutable v (PrimState m) a) + + -- | /Assumed complexity: O(1)/ + -- + -- Yield the length of the vector. + basicLength :: v a -> Int + + -- | /Assumed complexity: O(1)/ + -- + -- Yield a slice of the vector without copying it. No range checks are + -- performed. + basicUnsafeSlice :: Int -- ^ starting index + -> Int -- ^ length + -> v a -> v a + + -- | /Assumed complexity: O(1)/ + -- + -- Yield the element at the given position in a monad. No range checks are + -- performed. + -- + -- The monad allows us to be strict in the vector if we want. Suppose we had + -- + -- > unsafeIndex :: v a -> Int -> a + -- + -- instead. Now, if we wanted to copy a vector, we'd do something like + -- + -- > copy mv v ... = ... unsafeWrite mv i (unsafeIndex v i) ... + -- + -- For lazy vectors, the indexing would not be evaluated which means that we + -- would retain a reference to the original vector in each element we write. + -- This is not what we want! + -- + -- With 'basicUnsafeIndexM', we can do + -- + -- > copy mv v ... = ... case basicUnsafeIndexM v i of + -- > Box x -> unsafeWrite mv i x ... + -- + -- which does not have this problem because indexing (but not the returned + -- element!) is evaluated immediately. + -- + basicUnsafeIndexM :: Monad m => v a -> Int -> m a + + -- | /Assumed complexity: O(n)/ + -- + -- Copy an immutable vector into a mutable one. The two vectors must have + -- the same length but this is not checked. + -- + -- Instances of 'Vector' should redefine this method if they wish to support + -- an efficient block copy operation. + -- + -- Default definition: copying basic on 'basicUnsafeIndexM' and + -- 'basicUnsafeWrite'. + basicUnsafeCopy :: PrimMonad m => Mutable v (PrimState m) a -> v a -> m () + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy !dst !src = do_copy 0 + where + !n = basicLength src + + do_copy i | i < n = do + x <- basicUnsafeIndexM src i + M.basicUnsafeWrite dst i x + do_copy (i+1) + | otherwise = return () + + -- | Evaluate @a@ as far as storing it in a vector would and yield @b@. + -- The @v a@ argument only fixes the type and is not touched. The method is + -- only used for optimisation purposes. Thus, it is safe for instances of + -- 'Vector' to evaluate @a@ less than it would be when stored in a vector + -- although this might result in suboptimal code. + -- + -- > elemseq v x y = (singleton x `asTypeOf` v) `seq` y + -- + -- Default defintion: @a@ is not evaluated at all + -- + elemseq :: v a -> a -> b -> b + + {-# INLINE elemseq #-} + elemseq _ = \_ x -> x + + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable.hs new file mode 100644 index 0000000000..89bebf3607 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable.hs @@ -0,0 +1,1034 @@ +{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleContexts, BangPatterns, TypeFamilies, ScopedTypeVariables #-} +-- | +-- Module : Data.Vector.Generic.Mutable +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Generic interface to mutable vectors +-- + +module Data.Vector.Generic.Mutable ( + -- * Class of mutable vector types + MVector(..), + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, clone, + + -- ** Growing + grow, unsafeGrow, + growFront, unsafeGrowFront, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, write, modify, swap, exchange, + unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, unsafeExchange, + + -- * Modifying vectors + nextPermutation, + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove, + + -- * Internal operations + mstream, mstreamR, + unstream, unstreamR, vunstream, + munstream, munstreamR, + transform, transformR, + fill, fillR, + unsafeAccum, accum, unsafeUpdate, update, reverse, + unstablePartition, unstablePartitionBundle, partitionBundle +) where + +import Data.Vector.Generic.Mutable.Base +import qualified Data.Vector.Generic.Base as V + +import qualified Data.Vector.Fusion.Bundle as Bundle +import Data.Vector.Fusion.Bundle ( Bundle, MBundle, Chunk(..) ) +import qualified Data.Vector.Fusion.Bundle.Monadic as MBundle +import Data.Vector.Fusion.Stream.Monadic ( Stream ) +import qualified Data.Vector.Fusion.Stream.Monadic as Stream +import Data.Vector.Fusion.Bundle.Size +import Data.Vector.Fusion.Util ( delay_inline ) + +import Control.Monad.Primitive ( PrimMonad, PrimState ) + +import Prelude hiding ( length, null, replicate, reverse, map, read, + take, drop, splitAt, init, tail ) + +#include "vector.h" + +{- +type family Immutable (v :: * -> * -> *) :: * -> * + +-- | Class of mutable vectors parametrised with a primitive state token. +-- +class MBundle.Pointer u a => MVector v a where + -- | Length of the mutable vector. This method should not be + -- called directly, use 'length' instead. + basicLength :: v s a -> Int + + -- | Yield a part of the mutable vector without copying it. This method + -- should not be called directly, use 'unsafeSlice' instead. + basicUnsafeSlice :: Int -- ^ starting index + -> Int -- ^ length of the slice + -> v s a + -> v s a + + -- Check whether two vectors overlap. This method should not be + -- called directly, use 'overlaps' instead. + basicOverlaps :: v s a -> v s a -> Bool + + -- | Create a mutable vector of the given length. This method should not be + -- called directly, use 'unsafeNew' instead. + basicUnsafeNew :: PrimMonad m => Int -> m (v (PrimState m) a) + + -- | Create a mutable vector of the given length and fill it with an + -- initial value. This method should not be called directly, use + -- 'replicate' instead. + basicUnsafeReplicate :: PrimMonad m => Int -> a -> m (v (PrimState m) a) + + -- | Yield the element at the given position. This method should not be + -- called directly, use 'unsafeRead' instead. + basicUnsafeRead :: PrimMonad m => v (PrimState m) a -> Int -> m a + + -- | Replace the element at the given position. This method should not be + -- called directly, use 'unsafeWrite' instead. + basicUnsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m () + + -- | Reset all elements of the vector to some undefined value, clearing all + -- references to external objects. This is usually a noop for unboxed + -- vectors. This method should not be called directly, use 'clear' instead. + basicClear :: PrimMonad m => v (PrimState m) a -> m () + + -- | Set all elements of the vector to the given value. This method should + -- not be called directly, use 'set' instead. + basicSet :: PrimMonad m => v (PrimState m) a -> a -> m () + + basicUnsafeCopyPointer :: PrimMonad m => v (PrimState m) a + -> Immutable v a + -> m () + + -- | Copy a vector. The two vectors may not overlap. This method should not + -- be called directly, use 'unsafeCopy' instead. + basicUnsafeCopy :: PrimMonad m => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () + + -- | Move the contents of a vector. The two vectors may overlap. This method + -- should not be called directly, use 'unsafeMove' instead. + basicUnsafeMove :: PrimMonad m => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () + + -- | Grow a vector by the given number of elements. This method should not be + -- called directly, use 'unsafeGrow' instead. + basicUnsafeGrow :: PrimMonad m => v (PrimState m) a -> Int + -> m (v (PrimState m) a) + + {-# INLINE basicUnsafeReplicate #-} + basicUnsafeReplicate n x + = do + v <- basicUnsafeNew n + basicSet v x + return v + + {-# INLINE basicClear #-} + basicClear _ = return () + + {-# INLINE basicSet #-} + basicSet !v x + | n == 0 = return () + | otherwise = do + basicUnsafeWrite v 0 x + do_set 1 + where + !n = basicLength v + + do_set i | 2*i < n = do basicUnsafeCopy (basicUnsafeSlice i i v) + (basicUnsafeSlice 0 i v) + do_set (2*i) + | otherwise = basicUnsafeCopy (basicUnsafeSlice i (n-i) v) + (basicUnsafeSlice 0 (n-i) v) + + {-# INLINE basicUnsafeCopyPointer #-} + basicUnsafeCopyPointer !dst !src = do_copy 0 src + where + do_copy !i p | Just (x,q) <- MBundle.pget p = do + basicUnsafeWrite dst i x + do_copy (i+1) q + | otherwise = return () + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy !dst !src = do_copy 0 + where + !n = basicLength src + + do_copy i | i < n = do + x <- basicUnsafeRead src i + basicUnsafeWrite dst i x + do_copy (i+1) + | otherwise = return () + + {-# INLINE basicUnsafeMove #-} + basicUnsafeMove !dst !src + | basicOverlaps dst src = do + srcCopy <- clone src + basicUnsafeCopy dst srcCopy + | otherwise = basicUnsafeCopy dst src + + {-# INLINE basicUnsafeGrow #-} + basicUnsafeGrow v by + = do + v' <- basicUnsafeNew (n+by) + basicUnsafeCopy (basicUnsafeSlice 0 n v') v + return v' + where + n = basicLength v +-} + +-- ------------------ +-- Internal functions +-- ------------------ + +unsafeAppend1 :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> a -> m (v (PrimState m) a) +{-# INLINE_INNER unsafeAppend1 #-} + -- NOTE: The case distinction has to be on the outside because + -- GHC creates a join point for the unsafeWrite even when everything + -- is inlined. This is bad because with the join point, v isn't getting + -- unboxed. +unsafeAppend1 v i x + | i < length v = do + unsafeWrite v i x + return v + | otherwise = do + v' <- enlarge v + INTERNAL_CHECK(checkIndex) "unsafeAppend1" i (length v') + $ unsafeWrite v' i x + return v' + +unsafePrepend1 :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> a -> m (v (PrimState m) a, Int) +{-# INLINE_INNER unsafePrepend1 #-} +unsafePrepend1 v i x + | i /= 0 = do + let i' = i-1 + unsafeWrite v i' x + return (v, i') + | otherwise = do + (v', j) <- enlargeFront v + let i' = j-1 + INTERNAL_CHECK(checkIndex) "unsafePrepend1" i' (length v') + $ unsafeWrite v' i' x + return (v', i') + +mstream :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Stream m a +{-# INLINE mstream #-} +mstream v = v `seq` n `seq` (Stream.unfoldrM get 0) + where + n = length v + + {-# INLINE_INNER get #-} + get i | i < n = do x <- unsafeRead v i + return $ Just (x, i+1) + | otherwise = return $ Nothing + +fill :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Stream m a -> m (v (PrimState m) a) +{-# INLINE fill #-} +fill v s = v `seq` do + n' <- Stream.foldM put 0 s + return $ unsafeSlice 0 n' v + where + {-# INLINE_INNER put #-} + put i x = do + INTERNAL_CHECK(checkIndex) "fill" i (length v) + $ unsafeWrite v i x + return (i+1) + +transform + :: (PrimMonad m, MVector v a) + => (Stream m a -> Stream m a) -> v (PrimState m) a -> m (v (PrimState m) a) +{-# INLINE_FUSED transform #-} +transform f v = fill v (f (mstream v)) + +mstreamR :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Stream m a +{-# INLINE mstreamR #-} +mstreamR v = v `seq` n `seq` (Stream.unfoldrM get n) + where + n = length v + + {-# INLINE_INNER get #-} + get i | j >= 0 = do x <- unsafeRead v j + return $ Just (x,j) + | otherwise = return Nothing + where + j = i-1 + +fillR :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Stream m a -> m (v (PrimState m) a) +{-# INLINE fillR #-} +fillR v s = v `seq` do + i <- Stream.foldM put n s + return $ unsafeSlice i (n-i) v + where + n = length v + + {-# INLINE_INNER put #-} + put i x = do + unsafeWrite v j x + return j + where + j = i-1 + +transformR + :: (PrimMonad m, MVector v a) + => (Stream m a -> Stream m a) -> v (PrimState m) a -> m (v (PrimState m) a) +{-# INLINE_FUSED transformR #-} +transformR f v = fillR v (f (mstreamR v)) + +-- | Create a new mutable vector and fill it with elements from the 'Bundle'. +-- The vector will grow exponentially if the maximum size of the 'Bundle' is +-- unknown. +unstream :: (PrimMonad m, MVector v a) + => Bundle u a -> m (v (PrimState m) a) +-- NOTE: replace INLINE_FUSED by INLINE? (also in unstreamR) +{-# INLINE_FUSED unstream #-} +unstream s = munstream (Bundle.lift s) + +-- | Create a new mutable vector and fill it with elements from the monadic +-- stream. The vector will grow exponentially if the maximum size of the stream +-- is unknown. +munstream :: (PrimMonad m, MVector v a) + => MBundle m u a -> m (v (PrimState m) a) +{-# INLINE_FUSED munstream #-} +munstream s = case upperBound (MBundle.size s) of + Just n -> munstreamMax s n + Nothing -> munstreamUnknown s + +-- FIXME: I can't think of how to prevent GHC from floating out +-- unstreamUnknown. That is bad because SpecConstr then generates two +-- specialisations: one for when it is called from unstream (it doesn't know +-- the shape of the vector) and one for when the vector has grown. To see the +-- problem simply compile this: +-- +-- fromList = Data.Vector.Unboxed.unstream . Bundle.fromList +-- +-- I'm not sure this still applies (19/04/2010) + +munstreamMax :: (PrimMonad m, MVector v a) + => MBundle m u a -> Int -> m (v (PrimState m) a) +{-# INLINE munstreamMax #-} +munstreamMax s n + = do + v <- INTERNAL_CHECK(checkLength) "munstreamMax" n + $ unsafeNew n + let put i x = do + INTERNAL_CHECK(checkIndex) "munstreamMax" i n + $ unsafeWrite v i x + return (i+1) + n' <- MBundle.foldM' put 0 s + return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n + $ unsafeSlice 0 n' v + +munstreamUnknown :: (PrimMonad m, MVector v a) + => MBundle m u a -> m (v (PrimState m) a) +{-# INLINE munstreamUnknown #-} +munstreamUnknown s + = do + v <- unsafeNew 0 + (v', n) <- MBundle.foldM put (v, 0) s + return $ INTERNAL_CHECK(checkSlice) "munstreamUnknown" 0 n (length v') + $ unsafeSlice 0 n v' + where + {-# INLINE_INNER put #-} + put (v,i) x = do + v' <- unsafeAppend1 v i x + return (v',i+1) + + + + + + + +-- | Create a new mutable vector and fill it with elements from the 'Bundle'. +-- The vector will grow exponentially if the maximum size of the 'Bundle' is +-- unknown. +vunstream :: (PrimMonad m, V.Vector v a) + => Bundle v a -> m (V.Mutable v (PrimState m) a) +-- NOTE: replace INLINE_FUSED by INLINE? (also in unstreamR) +{-# INLINE_FUSED vunstream #-} +vunstream s = vmunstream (Bundle.lift s) + +-- | Create a new mutable vector and fill it with elements from the monadic +-- stream. The vector will grow exponentially if the maximum size of the stream +-- is unknown. +vmunstream :: (PrimMonad m, V.Vector v a) + => MBundle m v a -> m (V.Mutable v (PrimState m) a) +{-# INLINE_FUSED vmunstream #-} +vmunstream s = case upperBound (MBundle.size s) of + Just n -> vmunstreamMax s n + Nothing -> vmunstreamUnknown s + +-- FIXME: I can't think of how to prevent GHC from floating out +-- unstreamUnknown. That is bad because SpecConstr then generates two +-- specialisations: one for when it is called from unstream (it doesn't know +-- the shape of the vector) and one for when the vector has grown. To see the +-- problem simply compile this: +-- +-- fromList = Data.Vector.Unboxed.unstream . Bundle.fromList +-- +-- I'm not sure this still applies (19/04/2010) + +vmunstreamMax :: (PrimMonad m, V.Vector v a) + => MBundle m v a -> Int -> m (V.Mutable v (PrimState m) a) +{-# INLINE vmunstreamMax #-} +vmunstreamMax s n + = do + v <- INTERNAL_CHECK(checkLength) "munstreamMax" n + $ unsafeNew n + let {-# INLINE_INNER copyChunk #-} + copyChunk i (Chunk m f) = + INTERNAL_CHECK(checkSlice) "munstreamMax.copyChunk" i m (length v) $ do + f (basicUnsafeSlice i m v) + return (i+m) + + n' <- Stream.foldlM' copyChunk 0 (MBundle.chunks s) + return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n + $ unsafeSlice 0 n' v + +vmunstreamUnknown :: (PrimMonad m, V.Vector v a) + => MBundle m v a -> m (V.Mutable v (PrimState m) a) +{-# INLINE vmunstreamUnknown #-} +vmunstreamUnknown s + = do + v <- unsafeNew 0 + (v', n) <- Stream.foldlM copyChunk (v,0) (MBundle.chunks s) + return $ INTERNAL_CHECK(checkSlice) "munstreamUnknown" 0 n (length v') + $ unsafeSlice 0 n v' + where + {-# INLINE_INNER copyChunk #-} + copyChunk (v,i) (Chunk n f) + = do + let j = i+n + v' <- if basicLength v < j + then unsafeGrow v (delay_inline max (enlarge_delta v) (j - basicLength v)) + else return v + INTERNAL_CHECK(checkSlice) "munstreamUnknown.copyChunk" i n (length v') + $ f (basicUnsafeSlice i n v') + return (v',j) + + + + +-- | Create a new mutable vector and fill it with elements from the 'Bundle' +-- from right to left. The vector will grow exponentially if the maximum size +-- of the 'Bundle' is unknown. +unstreamR :: (PrimMonad m, MVector v a) + => Bundle u a -> m (v (PrimState m) a) +-- NOTE: replace INLINE_FUSED by INLINE? (also in unstream) +{-# INLINE_FUSED unstreamR #-} +unstreamR s = munstreamR (Bundle.lift s) + +-- | Create a new mutable vector and fill it with elements from the monadic +-- stream from right to left. The vector will grow exponentially if the maximum +-- size of the stream is unknown. +munstreamR :: (PrimMonad m, MVector v a) + => MBundle m u a -> m (v (PrimState m) a) +{-# INLINE_FUSED munstreamR #-} +munstreamR s = case upperBound (MBundle.size s) of + Just n -> munstreamRMax s n + Nothing -> munstreamRUnknown s + +munstreamRMax :: (PrimMonad m, MVector v a) + => MBundle m u a -> Int -> m (v (PrimState m) a) +{-# INLINE munstreamRMax #-} +munstreamRMax s n + = do + v <- INTERNAL_CHECK(checkLength) "munstreamRMax" n + $ unsafeNew n + let put i x = do + let i' = i-1 + INTERNAL_CHECK(checkIndex) "munstreamRMax" i' n + $ unsafeWrite v i' x + return i' + i <- MBundle.foldM' put n s + return $ INTERNAL_CHECK(checkSlice) "munstreamRMax" i (n-i) n + $ unsafeSlice i (n-i) v + +munstreamRUnknown :: (PrimMonad m, MVector v a) + => MBundle m u a -> m (v (PrimState m) a) +{-# INLINE munstreamRUnknown #-} +munstreamRUnknown s + = do + v <- unsafeNew 0 + (v', i) <- MBundle.foldM put (v, 0) s + let n = length v' + return $ INTERNAL_CHECK(checkSlice) "unstreamRUnknown" i (n-i) n + $ unsafeSlice i (n-i) v' + where + {-# INLINE_INNER put #-} + put (v,i) x = unsafePrepend1 v i x + +-- Length +-- ------ + +-- | Length of the mutable vector. +length :: MVector v a => v s a -> Int +{-# INLINE length #-} +length = basicLength + +-- | Check whether the vector is empty +null :: MVector v a => v s a -> Bool +{-# INLINE null #-} +null v = length v == 0 + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. +slice :: MVector v a => Int -> Int -> v s a -> v s a +{-# INLINE slice #-} +slice i n v = BOUNDS_CHECK(checkSlice) "slice" i n (length v) + $ unsafeSlice i n v + +take :: MVector v a => Int -> v s a -> v s a +{-# INLINE take #-} +take n v = unsafeSlice 0 (min (max n 0) (length v)) v + +drop :: MVector v a => Int -> v s a -> v s a +{-# INLINE drop #-} +drop n v = unsafeSlice (min m n') (max 0 (m - n')) v + where + n' = max n 0 + m = length v + +{-# INLINE splitAt #-} +splitAt :: MVector v a => Int -> v s a -> (v s a, v s a) +splitAt n v = ( unsafeSlice 0 m v + , unsafeSlice m (max 0 (len - n')) v + ) + where + m = min n' len + n' = max n 0 + len = length v + +init :: MVector v a => v s a -> v s a +{-# INLINE init #-} +init v = slice 0 (length v - 1) v + +tail :: MVector v a => v s a -> v s a +{-# INLINE tail #-} +tail v = slice 1 (length v - 1) v + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +unsafeSlice :: MVector v a => Int -- ^ starting index + -> Int -- ^ length of the slice + -> v s a + -> v s a +{-# INLINE unsafeSlice #-} +unsafeSlice i n v = UNSAFE_CHECK(checkSlice) "unsafeSlice" i n (length v) + $ basicUnsafeSlice i n v + +unsafeInit :: MVector v a => v s a -> v s a +{-# INLINE unsafeInit #-} +unsafeInit v = unsafeSlice 0 (length v - 1) v + +unsafeTail :: MVector v a => v s a -> v s a +{-# INLINE unsafeTail #-} +unsafeTail v = unsafeSlice 1 (length v - 1) v + +unsafeTake :: MVector v a => Int -> v s a -> v s a +{-# INLINE unsafeTake #-} +unsafeTake n v = unsafeSlice 0 n v + +unsafeDrop :: MVector v a => Int -> v s a -> v s a +{-# INLINE unsafeDrop #-} +unsafeDrop n v = unsafeSlice n (length v - n) v + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +overlaps :: MVector v a => v s a -> v s a -> Bool +{-# INLINE overlaps #-} +overlaps = basicOverlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +new :: (PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a) +{-# INLINE new #-} +new n = BOUNDS_CHECK(checkLength) "new" n + $ unsafeNew n >>= \v -> basicInitialize v >> return v + +-- | Create a mutable vector of the given length. The memory is not initialized. +unsafeNew :: (PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew n = UNSAFE_CHECK(checkLength) "unsafeNew" n + $ basicUnsafeNew n + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +replicate :: (PrimMonad m, MVector v a) => Int -> a -> m (v (PrimState m) a) +{-# INLINE replicate #-} +replicate n x = basicUnsafeReplicate (delay_inline max 0 n) x + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +replicateM :: (PrimMonad m, MVector v a) => Int -> m a -> m (v (PrimState m) a) +{-# INLINE replicateM #-} +replicateM n m = munstream (MBundle.replicateM n m) + +-- | Create a copy of a mutable vector. +clone :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m (v (PrimState m) a) +{-# INLINE clone #-} +clone v = do + v' <- unsafeNew (length v) + unsafeCopy v' v + return v' + +-- Growing +-- ------- + +-- | Grow a vector by the given number of elements. The number must be +-- positive. +grow :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> m (v (PrimState m) a) +{-# INLINE grow #-} +grow v by = BOUNDS_CHECK(checkLength) "grow" by + $ do vnew <- unsafeGrow v by + basicInitialize $ basicUnsafeSlice (length v) by vnew + return vnew + +growFront :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> m (v (PrimState m) a) +{-# INLINE growFront #-} +growFront v by = BOUNDS_CHECK(checkLength) "growFront" by + $ do vnew <- unsafeGrowFront v by + basicInitialize $ basicUnsafeSlice 0 by vnew + return vnew + +enlarge_delta :: MVector v a => v s a -> Int +enlarge_delta v = max (length v) 1 + +-- | Grow a vector logarithmically +enlarge :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> m (v (PrimState m) a) +{-# INLINE enlarge #-} +enlarge v = do vnew <- unsafeGrow v by + basicInitialize $ basicUnsafeSlice (length v) by vnew + return vnew + where + by = enlarge_delta v + +enlargeFront :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> m (v (PrimState m) a, Int) +{-# INLINE enlargeFront #-} +enlargeFront v = do + v' <- unsafeGrowFront v by + basicInitialize $ basicUnsafeSlice 0 by v' + return (v', by) + where + by = enlarge_delta v + +-- | Grow a vector by the given number of elements. The number must be +-- positive but this is not checked. +unsafeGrow :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> m (v (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow v n = UNSAFE_CHECK(checkLength) "unsafeGrow" n + $ basicUnsafeGrow v n + +unsafeGrowFront :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> m (v (PrimState m) a) +{-# INLINE unsafeGrowFront #-} +unsafeGrowFront v by = UNSAFE_CHECK(checkLength) "unsafeGrowFront" by + $ do + let n = length v + v' <- basicUnsafeNew (by+n) + basicUnsafeCopy (basicUnsafeSlice by n v') v + return v' + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- references to external objects. This is usually a noop for unboxed vectors. +clear :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m () +{-# INLINE clear #-} +clear = basicClear + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. +read :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read v i = BOUNDS_CHECK(checkIndex) "read" i (length v) + $ unsafeRead v i + +-- | Replace the element at the given position. +write :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m () +{-# INLINE write #-} +write v i x = BOUNDS_CHECK(checkIndex) "write" i (length v) + $ unsafeWrite v i x + +-- | Modify the element at the given position. +modify :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE modify #-} +modify v f i = BOUNDS_CHECK(checkIndex) "modify" i (length v) + $ unsafeModify v f i + +-- | Swap the elements at the given positions. +swap :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap v i j = BOUNDS_CHECK(checkIndex) "swap" i (length v) + $ BOUNDS_CHECK(checkIndex) "swap" j (length v) + $ unsafeSwap v i j + +-- | Replace the element at the give position and return the old element. +exchange :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m a +{-# INLINE exchange #-} +exchange v i x = BOUNDS_CHECK(checkIndex) "exchange" i (length v) + $ unsafeExchange v i x + +-- | Yield the element at the given position. No bounds checks are performed. +unsafeRead :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +unsafeRead v i = UNSAFE_CHECK(checkIndex) "unsafeRead" i (length v) + $ basicUnsafeRead v i + +-- | Replace the element at the given position. No bounds checks are performed. +unsafeWrite :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> a -> m () +{-# INLINE unsafeWrite #-} +unsafeWrite v i x = UNSAFE_CHECK(checkIndex) "unsafeWrite" i (length v) + $ basicUnsafeWrite v i x + +-- | Modify the element at the given position. No bounds checks are performed. +unsafeModify :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE unsafeModify #-} +unsafeModify v f i = UNSAFE_CHECK(checkIndex) "unsafeModify" i (length v) + $ basicUnsafeRead v i >>= \x -> + basicUnsafeWrite v i (f x) + +-- | Swap the elements at the given positions. No bounds checks are performed. +unsafeSwap :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> Int -> m () +{-# INLINE unsafeSwap #-} +unsafeSwap v i j = UNSAFE_CHECK(checkIndex) "unsafeSwap" i (length v) + $ UNSAFE_CHECK(checkIndex) "unsafeSwap" j (length v) + $ do + x <- unsafeRead v i + y <- unsafeRead v j + unsafeWrite v i y + unsafeWrite v j x + +-- | Replace the element at the give position and return the old element. No +-- bounds checks are performed. +unsafeExchange :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Int -> a -> m a +{-# INLINE unsafeExchange #-} +unsafeExchange v i x = UNSAFE_CHECK(checkIndex) "unsafeExchange" i (length v) + $ do + y <- unsafeRead v i + unsafeWrite v i x + return y + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +set :: (PrimMonad m, MVector v a) => v (PrimState m) a -> a -> m () +{-# INLINE set #-} +set = basicSet + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +copy :: (PrimMonad m, MVector v a) => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () +{-# INLINE copy #-} +copy dst src = BOUNDS_CHECK(check) "copy" "overlapping vectors" + (not (dst `overlaps` src)) + $ BOUNDS_CHECK(check) "copy" "length mismatch" + (length dst == length src) + $ unsafeCopy dst src + +-- | Move the contents of a vector. The two vectors must have the same +-- length. +-- +-- If the vectors do not overlap, then this is equivalent to 'copy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +move :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> v (PrimState m) a -> m () +{-# INLINE move #-} +move dst src = BOUNDS_CHECK(check) "move" "length mismatch" + (length dst == length src) + $ unsafeMove dst src + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. This is not checked. +unsafeCopy :: (PrimMonad m, MVector v a) => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy dst src = UNSAFE_CHECK(check) "unsafeCopy" "length mismatch" + (length dst == length src) + $ UNSAFE_CHECK(check) "unsafeCopy" "overlapping vectors" + (not (dst `overlaps` src)) + $ (dst `seq` src `seq` basicUnsafeCopy dst src) + +-- | Move the contents of a vector. The two vectors must have the same +-- length, but this is not checked. +-- +-- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +unsafeMove :: (PrimMonad m, MVector v a) => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove dst src = UNSAFE_CHECK(check) "unsafeMove" "length mismatch" + (length dst == length src) + $ (dst `seq` src `seq` basicUnsafeMove dst src) + +-- Permutations +-- ------------ + +accum :: (PrimMonad m, MVector v a) + => (a -> b -> a) -> v (PrimState m) a -> Bundle u (Int, b) -> m () +{-# INLINE accum #-} +accum f !v s = Bundle.mapM_ upd s + where + {-# INLINE_INNER upd #-} + upd (i,b) = do + a <- BOUNDS_CHECK(checkIndex) "accum" i n + $ unsafeRead v i + unsafeWrite v i (f a b) + + !n = length v + +update :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Bundle u (Int, a) -> m () +{-# INLINE update #-} +update !v s = Bundle.mapM_ upd s + where + {-# INLINE_INNER upd #-} + upd (i,b) = BOUNDS_CHECK(checkIndex) "update" i n + $ unsafeWrite v i b + + !n = length v + +unsafeAccum :: (PrimMonad m, MVector v a) + => (a -> b -> a) -> v (PrimState m) a -> Bundle u (Int, b) -> m () +{-# INLINE unsafeAccum #-} +unsafeAccum f !v s = Bundle.mapM_ upd s + where + {-# INLINE_INNER upd #-} + upd (i,b) = do + a <- UNSAFE_CHECK(checkIndex) "accum" i n + $ unsafeRead v i + unsafeWrite v i (f a b) + + !n = length v + +unsafeUpdate :: (PrimMonad m, MVector v a) + => v (PrimState m) a -> Bundle u (Int, a) -> m () +{-# INLINE unsafeUpdate #-} +unsafeUpdate !v s = Bundle.mapM_ upd s + where + {-# INLINE_INNER upd #-} + upd (i,b) = UNSAFE_CHECK(checkIndex) "accum" i n + $ unsafeWrite v i b + + !n = length v + +reverse :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m () +{-# INLINE reverse #-} +reverse !v = reverse_loop 0 (length v - 1) + where + reverse_loop i j | i < j = do + unsafeSwap v i j + reverse_loop (i + 1) (j - 1) + reverse_loop _ _ = return () + +unstablePartition :: forall m v a. (PrimMonad m, MVector v a) + => (a -> Bool) -> v (PrimState m) a -> m Int +{-# INLINE unstablePartition #-} +unstablePartition f !v = from_left 0 (length v) + where + -- NOTE: GHC 6.10.4 panics without the signatures on from_left and + -- from_right + from_left :: Int -> Int -> m Int + from_left i j + | i == j = return i + | otherwise = do + x <- unsafeRead v i + if f x + then from_left (i+1) j + else from_right i (j-1) + + from_right :: Int -> Int -> m Int + from_right i j + | i == j = return i + | otherwise = do + x <- unsafeRead v j + if f x + then do + y <- unsafeRead v i + unsafeWrite v i x + unsafeWrite v j y + from_left (i+1) j + else from_right i (j-1) + +unstablePartitionBundle :: (PrimMonad m, MVector v a) + => (a -> Bool) -> Bundle u a -> m (v (PrimState m) a, v (PrimState m) a) +{-# INLINE unstablePartitionBundle #-} +unstablePartitionBundle f s + = case upperBound (Bundle.size s) of + Just n -> unstablePartitionMax f s n + Nothing -> partitionUnknown f s + +unstablePartitionMax :: (PrimMonad m, MVector v a) + => (a -> Bool) -> Bundle u a -> Int + -> m (v (PrimState m) a, v (PrimState m) a) +{-# INLINE unstablePartitionMax #-} +unstablePartitionMax f s n + = do + v <- INTERNAL_CHECK(checkLength) "unstablePartitionMax" n + $ unsafeNew n + let {-# INLINE_INNER put #-} + put (i, j) x + | f x = do + unsafeWrite v i x + return (i+1, j) + | otherwise = do + unsafeWrite v (j-1) x + return (i, j-1) + + (i,j) <- Bundle.foldM' put (0, n) s + return (unsafeSlice 0 i v, unsafeSlice j (n-j) v) + +partitionBundle :: (PrimMonad m, MVector v a) + => (a -> Bool) -> Bundle u a -> m (v (PrimState m) a, v (PrimState m) a) +{-# INLINE partitionBundle #-} +partitionBundle f s + = case upperBound (Bundle.size s) of + Just n -> partitionMax f s n + Nothing -> partitionUnknown f s + +partitionMax :: (PrimMonad m, MVector v a) + => (a -> Bool) -> Bundle u a -> Int -> m (v (PrimState m) a, v (PrimState m) a) +{-# INLINE partitionMax #-} +partitionMax f s n + = do + v <- INTERNAL_CHECK(checkLength) "unstablePartitionMax" n + $ unsafeNew n + + let {-# INLINE_INNER put #-} + put (i,j) x + | f x = do + unsafeWrite v i x + return (i+1,j) + + | otherwise = let j' = j-1 in + do + unsafeWrite v j' x + return (i,j') + + (i,j) <- Bundle.foldM' put (0,n) s + INTERNAL_CHECK(check) "partitionMax" "invalid indices" (i <= j) + $ return () + let l = unsafeSlice 0 i v + r = unsafeSlice j (n-j) v + reverse r + return (l,r) + +partitionUnknown :: (PrimMonad m, MVector v a) + => (a -> Bool) -> Bundle u a -> m (v (PrimState m) a, v (PrimState m) a) +{-# INLINE partitionUnknown #-} +partitionUnknown f s + = do + v1 <- unsafeNew 0 + v2 <- unsafeNew 0 + (v1', n1, v2', n2) <- Bundle.foldM' put (v1, 0, v2, 0) s + INTERNAL_CHECK(checkSlice) "partitionUnknown" 0 n1 (length v1') + $ INTERNAL_CHECK(checkSlice) "partitionUnknown" 0 n2 (length v2') + $ return (unsafeSlice 0 n1 v1', unsafeSlice 0 n2 v2') + where + -- NOTE: The case distinction has to be on the outside because + -- GHC creates a join point for the unsafeWrite even when everything + -- is inlined. This is bad because with the join point, v isn't getting + -- unboxed. + {-# INLINE_INNER put #-} + put (v1, i1, v2, i2) x + | f x = do + v1' <- unsafeAppend1 v1 i1 x + return (v1', i1+1, v2, i2) + | otherwise = do + v2' <- unsafeAppend1 v2 i2 x + return (v1, i1, v2', i2+1) + +{- +http://en.wikipedia.org/wiki/Permutation#Algorithms_to_generate_permutations + +The following algorithm generates the next permutation lexicographically after +a given permutation. It changes the given permutation in-place. + +1. Find the largest index k such that a[k] < a[k + 1]. If no such index exists, + the permutation is the last permutation. +2. Find the largest index l greater than k such that a[k] < a[l]. +3. Swap the value of a[k] with that of a[l]. +4. Reverse the sequence from a[k + 1] up to and including the final element a[n] +-} + +-- | Compute the next (lexicographically) permutation of given vector in-place. +-- Returns False when input is the last permtuation +nextPermutation :: (PrimMonad m,Ord e,MVector v e) => v (PrimState m) e -> m Bool +nextPermutation v + | dim < 2 = return False + | otherwise = do + val <- unsafeRead v 0 + (k,l) <- loop val (-1) 0 val 1 + if k < 0 + then return False + else unsafeSwap v k l >> + reverse (unsafeSlice (k+1) (dim-k-1) v) >> + return True + where loop !kval !k !l !prev !i + | i == dim = return (k,l) + | otherwise = do + cur <- unsafeRead v i + -- TODO: make tuple unboxed + let (kval',k') = if prev < cur then (prev,i-1) else (kval,k) + l' = if kval' < cur then i else l + loop kval' k' l' cur (i+1) + dim = length v diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable/Base.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable/Base.hs new file mode 100644 index 0000000000..ce931eec9b --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/Mutable/Base.hs @@ -0,0 +1,145 @@ +{-# LANGUAGE CPP, MultiParamTypeClasses, BangPatterns, TypeFamilies #-} +-- | +-- Module : Data.Vector.Generic.Mutable.Base +-- Copyright : (c) Roman Leshchinskiy 2008-2011 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Class of mutable vectors +-- + +module Data.Vector.Generic.Mutable.Base ( + MVector(..) +) where + +import Control.Monad.Primitive ( PrimMonad, PrimState ) + +-- Data.Vector.Internal.Check is unused +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- | Class of mutable vectors parametrised with a primitive state token. +-- +class MVector v a where + -- | Length of the mutable vector. This method should not be + -- called directly, use 'length' instead. + basicLength :: v s a -> Int + + -- | Yield a part of the mutable vector without copying it. This method + -- should not be called directly, use 'unsafeSlice' instead. + basicUnsafeSlice :: Int -- ^ starting index + -> Int -- ^ length of the slice + -> v s a + -> v s a + + -- | Check whether two vectors overlap. This method should not be + -- called directly, use 'overlaps' instead. + basicOverlaps :: v s a -> v s a -> Bool + + -- | Create a mutable vector of the given length. This method should not be + -- called directly, use 'unsafeNew' instead. + basicUnsafeNew :: PrimMonad m => Int -> m (v (PrimState m) a) + + -- | Initialize a vector to a standard value. This is intended to be called as + -- part of the safe new operation (and similar operations), to properly blank + -- the newly allocated memory if necessary. + -- + -- Vectors that are necessarily initialized as part of creation may implement + -- this as a no-op. + basicInitialize :: PrimMonad m => v (PrimState m) a -> m () + + -- | Create a mutable vector of the given length and fill it with an + -- initial value. This method should not be called directly, use + -- 'replicate' instead. + basicUnsafeReplicate :: PrimMonad m => Int -> a -> m (v (PrimState m) a) + + -- | Yield the element at the given position. This method should not be + -- called directly, use 'unsafeRead' instead. + basicUnsafeRead :: PrimMonad m => v (PrimState m) a -> Int -> m a + + -- | Replace the element at the given position. This method should not be + -- called directly, use 'unsafeWrite' instead. + basicUnsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m () + + -- | Reset all elements of the vector to some undefined value, clearing all + -- references to external objects. This is usually a noop for unboxed + -- vectors. This method should not be called directly, use 'clear' instead. + basicClear :: PrimMonad m => v (PrimState m) a -> m () + + -- | Set all elements of the vector to the given value. This method should + -- not be called directly, use 'set' instead. + basicSet :: PrimMonad m => v (PrimState m) a -> a -> m () + + -- | Copy a vector. The two vectors may not overlap. This method should not + -- be called directly, use 'unsafeCopy' instead. + basicUnsafeCopy :: PrimMonad m => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () + + -- | Move the contents of a vector. The two vectors may overlap. This method + -- should not be called directly, use 'unsafeMove' instead. + basicUnsafeMove :: PrimMonad m => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () + + -- | Grow a vector by the given number of elements. This method should not be + -- called directly, use 'unsafeGrow' instead. + basicUnsafeGrow :: PrimMonad m => v (PrimState m) a -> Int + -> m (v (PrimState m) a) + + {-# INLINE basicUnsafeReplicate #-} + basicUnsafeReplicate n x + = do + v <- basicUnsafeNew n + basicSet v x + return v + + {-# INLINE basicClear #-} + basicClear _ = return () + + {-# INLINE basicSet #-} + basicSet !v x + | n == 0 = return () + | otherwise = do + basicUnsafeWrite v 0 x + do_set 1 + where + !n = basicLength v + + do_set i | 2*i < n = do basicUnsafeCopy (basicUnsafeSlice i i v) + (basicUnsafeSlice 0 i v) + do_set (2*i) + | otherwise = basicUnsafeCopy (basicUnsafeSlice i (n-i) v) + (basicUnsafeSlice 0 (n-i) v) + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy !dst !src = do_copy 0 + where + !n = basicLength src + + do_copy i | i < n = do + x <- basicUnsafeRead src i + basicUnsafeWrite dst i x + do_copy (i+1) + | otherwise = return () + + {-# INLINE basicUnsafeMove #-} + basicUnsafeMove !dst !src + | basicOverlaps dst src = do + srcCopy <- basicUnsafeNew (basicLength src) + basicUnsafeCopy srcCopy src + basicUnsafeCopy dst srcCopy + | otherwise = basicUnsafeCopy dst src + + {-# INLINE basicUnsafeGrow #-} + basicUnsafeGrow v by + = do + v' <- basicUnsafeNew (n+by) + basicUnsafeCopy (basicUnsafeSlice 0 n v') v + return v' + where + n = basicLength v + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/New.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/New.hs new file mode 100644 index 0000000000..e94ce19e16 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Generic/New.hs @@ -0,0 +1,178 @@ +{-# LANGUAGE CPP, Rank2Types, FlexibleContexts, MultiParamTypeClasses #-} + +-- | +-- Module : Data.Vector.Generic.New +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Purely functional interface to initialisation of mutable vectors +-- + +module Data.Vector.Generic.New ( + New(..), create, run, runPrim, apply, modify, modifyWithBundle, + unstream, transform, unstreamR, transformR, + slice, init, tail, take, drop, + unsafeSlice, unsafeInit, unsafeTail +) where + +import qualified Data.Vector.Generic.Mutable as MVector + +import Data.Vector.Generic.Base ( Vector, Mutable ) + +import Data.Vector.Fusion.Bundle ( Bundle ) +import qualified Data.Vector.Fusion.Bundle as Bundle +import Data.Vector.Fusion.Stream.Monadic ( Stream ) +import Data.Vector.Fusion.Bundle.Size + +import Control.Monad.Primitive +import Control.Monad.ST ( ST ) +import Control.Monad ( liftM ) +import Prelude hiding ( init, tail, take, drop, reverse, map, filter ) + +-- Data.Vector.Internal.Check is unused +#define NOT_VECTOR_MODULE +#include "vector.h" + +data New v a = New (forall s. ST s (Mutable v s a)) + +create :: (forall s. ST s (Mutable v s a)) -> New v a +{-# INLINE create #-} +create p = New p + +run :: New v a -> ST s (Mutable v s a) +{-# INLINE run #-} +run (New p) = p + +runPrim :: PrimMonad m => New v a -> m (Mutable v (PrimState m) a) +{-# INLINE runPrim #-} +runPrim (New p) = primToPrim p + +apply :: (forall s. Mutable v s a -> Mutable v s a) -> New v a -> New v a +{-# INLINE apply #-} +apply f (New p) = New (liftM f p) + +modify :: (forall s. Mutable v s a -> ST s ()) -> New v a -> New v a +{-# INLINE modify #-} +modify f (New p) = New (do { v <- p; f v; return v }) + +modifyWithBundle :: (forall s. Mutable v s a -> Bundle u b -> ST s ()) + -> New v a -> Bundle u b -> New v a +{-# INLINE_FUSED modifyWithBundle #-} +modifyWithBundle f (New p) s = s `seq` New (do { v <- p; f v s; return v }) + +unstream :: Vector v a => Bundle v a -> New v a +{-# INLINE_FUSED unstream #-} +unstream s = s `seq` New (MVector.vunstream s) + +transform + :: Vector v a => (forall m. Monad m => Stream m a -> Stream m a) + -> (Size -> Size) -> New v a -> New v a +{-# INLINE_FUSED transform #-} +transform f _ (New p) = New (MVector.transform f =<< p) + +{-# RULES + +"transform/transform [New]" + forall (f1 :: forall m. Monad m => Stream m a -> Stream m a) + (f2 :: forall m. Monad m => Stream m a -> Stream m a) + g1 g2 p . + transform f1 g1 (transform f2 g2 p) = transform (f1 . f2) (g1 . g2) p + +"transform/unstream [New]" + forall (f :: forall m. Monad m => Stream m a -> Stream m a) + g s. + transform f g (unstream s) = unstream (Bundle.inplace f g s) #-} + + + + +unstreamR :: Vector v a => Bundle v a -> New v a +{-# INLINE_FUSED unstreamR #-} +unstreamR s = s `seq` New (MVector.unstreamR s) + +transformR + :: Vector v a => (forall m. Monad m => Stream m a -> Stream m a) + -> (Size -> Size) -> New v a -> New v a +{-# INLINE_FUSED transformR #-} +transformR f _ (New p) = New (MVector.transformR f =<< p) + +{-# RULES + +"transformR/transformR [New]" + forall (f1 :: forall m. Monad m => Stream m a -> Stream m a) + (f2 :: forall m. Monad m => Stream m a -> Stream m a) + g1 g2 + p . + transformR f1 g1 (transformR f2 g2 p) = transformR (f1 . f2) (g1 . g2) p + +"transformR/unstreamR [New]" + forall (f :: forall m. Monad m => Stream m a -> Stream m a) + g s. + transformR f g (unstreamR s) = unstreamR (Bundle.inplace f g s) #-} + + + +slice :: Vector v a => Int -> Int -> New v a -> New v a +{-# INLINE_FUSED slice #-} +slice i n m = apply (MVector.slice i n) m + +init :: Vector v a => New v a -> New v a +{-# INLINE_FUSED init #-} +init m = apply MVector.init m + +tail :: Vector v a => New v a -> New v a +{-# INLINE_FUSED tail #-} +tail m = apply MVector.tail m + +take :: Vector v a => Int -> New v a -> New v a +{-# INLINE_FUSED take #-} +take n m = apply (MVector.take n) m + +drop :: Vector v a => Int -> New v a -> New v a +{-# INLINE_FUSED drop #-} +drop n m = apply (MVector.drop n) m + +unsafeSlice :: Vector v a => Int -> Int -> New v a -> New v a +{-# INLINE_FUSED unsafeSlice #-} +unsafeSlice i n m = apply (MVector.unsafeSlice i n) m + +unsafeInit :: Vector v a => New v a -> New v a +{-# INLINE_FUSED unsafeInit #-} +unsafeInit m = apply MVector.unsafeInit m + +unsafeTail :: Vector v a => New v a -> New v a +{-# INLINE_FUSED unsafeTail #-} +unsafeTail m = apply MVector.unsafeTail m + +{-# RULES + +"slice/unstream [New]" forall i n s. + slice i n (unstream s) = unstream (Bundle.slice i n s) + +"init/unstream [New]" forall s. + init (unstream s) = unstream (Bundle.init s) + +"tail/unstream [New]" forall s. + tail (unstream s) = unstream (Bundle.tail s) + +"take/unstream [New]" forall n s. + take n (unstream s) = unstream (Bundle.take n s) + +"drop/unstream [New]" forall n s. + drop n (unstream s) = unstream (Bundle.drop n s) + +"unsafeSlice/unstream [New]" forall i n s. + unsafeSlice i n (unstream s) = unstream (Bundle.slice i n s) + +"unsafeInit/unstream [New]" forall s. + unsafeInit (unstream s) = unstream (Bundle.init s) + +"unsafeTail/unstream [New]" forall s. + unsafeTail (unstream s) = unstream (Bundle.tail s) #-} + + + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Internal/Check.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Internal/Check.hs new file mode 100644 index 0000000000..4a4ef80fe1 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Internal/Check.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE CPP #-} + +-- | +-- Module : Data.Vector.Internal.Check +-- Copyright : (c) Roman Leshchinskiy 2009 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Bounds checking infrastructure +-- + +{-# LANGUAGE MagicHash #-} + +module Data.Vector.Internal.Check ( + Checks(..), doChecks, + + error, internalError, + check, checkIndex, checkLength, checkSlice +) where + +import GHC.Base( Int(..) ) +import GHC.Prim( Int# ) +import Prelude hiding( error, (&&), (||), not ) +import qualified Prelude as P + +-- NOTE: This is a workaround for GHC's weird behaviour where it doesn't inline +-- these functions into unfoldings which makes the intermediate code size +-- explode. See http://hackage.haskell.org/trac/ghc/ticket/5539. +infixr 2 || +infixr 3 && + +not :: Bool -> Bool +{-# INLINE not #-} +not True = False +not False = True + +(&&) :: Bool -> Bool -> Bool +{-# INLINE (&&) #-} +False && _ = False +True && x = x + +(||) :: Bool -> Bool -> Bool +{-# INLINE (||) #-} +True || _ = True +False || x = x + + +data Checks = Bounds | Unsafe | Internal deriving( Eq ) + +doBoundsChecks :: Bool +#ifdef VECTOR_BOUNDS_CHECKS +doBoundsChecks = True +#else +doBoundsChecks = False +#endif + +doUnsafeChecks :: Bool +#ifdef VECTOR_UNSAFE_CHECKS +doUnsafeChecks = True +#else +doUnsafeChecks = False +#endif + +doInternalChecks :: Bool +#ifdef VECTOR_INTERNAL_CHECKS +doInternalChecks = True +#else +doInternalChecks = False +#endif + + +doChecks :: Checks -> Bool +{-# INLINE doChecks #-} +doChecks Bounds = doBoundsChecks +doChecks Unsafe = doUnsafeChecks +doChecks Internal = doInternalChecks + +error_msg :: String -> Int -> String -> String -> String +error_msg file line loc msg = file ++ ":" ++ show line ++ " (" ++ loc ++ "): " ++ msg + +error :: String -> Int -> String -> String -> a +{-# NOINLINE error #-} +error file line loc msg + = P.error $ error_msg file line loc msg + +internalError :: String -> Int -> String -> String -> a +{-# NOINLINE internalError #-} +internalError file line loc msg + = P.error $ unlines + ["*** Internal error in package vector ***" + ,"*** Please submit a bug report at http://trac.haskell.org/vector" + ,error_msg file line loc msg] + + +checkError :: String -> Int -> Checks -> String -> String -> a +{-# NOINLINE checkError #-} +checkError file line kind loc msg + = case kind of + Internal -> internalError file line loc msg + _ -> error file line loc msg + +check :: String -> Int -> Checks -> String -> String -> Bool -> a -> a +{-# INLINE check #-} +check file line kind loc msg cond x + | not (doChecks kind) || cond = x + | otherwise = checkError file line kind loc msg + +checkIndex_msg :: Int -> Int -> String +{-# INLINE checkIndex_msg #-} +checkIndex_msg (I# i#) (I# n#) = checkIndex_msg# i# n# + +checkIndex_msg# :: Int# -> Int# -> String +{-# NOINLINE checkIndex_msg# #-} +checkIndex_msg# i# n# = "index out of bounds " ++ show (I# i#, I# n#) + +checkIndex :: String -> Int -> Checks -> String -> Int -> Int -> a -> a +{-# INLINE checkIndex #-} +checkIndex file line kind loc i n x + = check file line kind loc (checkIndex_msg i n) (i >= 0 && i<n) x + + +checkLength_msg :: Int -> String +{-# INLINE checkLength_msg #-} +checkLength_msg (I# n#) = checkLength_msg# n# + +checkLength_msg# :: Int# -> String +{-# NOINLINE checkLength_msg# #-} +checkLength_msg# n# = "negative length " ++ show (I# n#) + +checkLength :: String -> Int -> Checks -> String -> Int -> a -> a +{-# INLINE checkLength #-} +checkLength file line kind loc n x + = check file line kind loc (checkLength_msg n) (n >= 0) x + + +checkSlice_msg :: Int -> Int -> Int -> String +{-# INLINE checkSlice_msg #-} +checkSlice_msg (I# i#) (I# m#) (I# n#) = checkSlice_msg# i# m# n# + +checkSlice_msg# :: Int# -> Int# -> Int# -> String +{-# NOINLINE checkSlice_msg# #-} +checkSlice_msg# i# m# n# = "invalid slice " ++ show (I# i#, I# m#, I# n#) + +checkSlice :: String -> Int -> Checks -> String -> Int -> Int -> Int -> a -> a +{-# INLINE checkSlice #-} +checkSlice file line kind loc i m n x + = check file line kind loc (checkSlice_msg i m n) + (i >= 0 && m >= 0 && i+m <= n) x + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Mutable.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Mutable.hs new file mode 100644 index 0000000000..ba701afb6a --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Mutable.hs @@ -0,0 +1,416 @@ +{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, BangPatterns, TypeFamilies #-} + +-- | +-- Module : Data.Vector.Mutable +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Mutable boxed vectors. +-- + +module Data.Vector.Mutable ( + -- * Mutable boxed vectors + MVector(..), IOVector, STVector, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, clone, + + -- ** Growing + grow, unsafeGrow, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, write, modify, swap, + unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, + + -- * Modifying vectors + nextPermutation, + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove +) where + +import Control.Monad (when) +import qualified Data.Vector.Generic.Mutable as G +import Data.Primitive.Array +import Control.Monad.Primitive + +import Prelude hiding ( length, null, replicate, reverse, read, + take, drop, splitAt, init, tail ) + +import Data.Typeable ( Typeable ) + +#include "vector.h" + +-- | Mutable boxed vectors keyed on the monad they live in ('IO' or @'ST' s@). +data MVector s a = MVector {-# UNPACK #-} !Int + {-# UNPACK #-} !Int + {-# UNPACK #-} !(MutableArray s a) + deriving ( Typeable ) + +type IOVector = MVector RealWorld +type STVector s = MVector s + +-- NOTE: This seems unsafe, see http://trac.haskell.org/vector/ticket/54 +{- +instance NFData a => NFData (MVector s a) where + rnf (MVector i n arr) = unsafeInlineST $ force i + where + force !ix | ix < n = do x <- readArray arr ix + rnf x `seq` force (ix+1) + | otherwise = return () +-} + +instance G.MVector MVector a where + {-# INLINE basicLength #-} + basicLength (MVector _ n _) = n + + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice j m (MVector i _ arr) = MVector (i+j) m arr + + {-# INLINE basicOverlaps #-} + basicOverlaps (MVector i m arr1) (MVector j n arr2) + = sameMutableArray arr1 arr2 + && (between i j (j+n) || between j i (i+m)) + where + between x y z = x >= y && x < z + + {-# INLINE basicUnsafeNew #-} + basicUnsafeNew n + = do + arr <- newArray n uninitialised + return (MVector 0 n arr) + + {-# INLINE basicInitialize #-} + -- initialization is unnecessary for boxed vectors + basicInitialize _ = return () + + {-# INLINE basicUnsafeReplicate #-} + basicUnsafeReplicate n x + = do + arr <- newArray n x + return (MVector 0 n arr) + + {-# INLINE basicUnsafeRead #-} + basicUnsafeRead (MVector i _ arr) j = readArray arr (i+j) + + {-# INLINE basicUnsafeWrite #-} + basicUnsafeWrite (MVector i _ arr) j x = writeArray arr (i+j) x + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MVector i n dst) (MVector j _ src) + = copyMutableArray dst i src j n + + basicUnsafeMove dst@(MVector iDst n arrDst) src@(MVector iSrc _ arrSrc) + = case n of + 0 -> return () + 1 -> readArray arrSrc iSrc >>= writeArray arrDst iDst + 2 -> do + x <- readArray arrSrc iSrc + y <- readArray arrSrc (iSrc + 1) + writeArray arrDst iDst x + writeArray arrDst (iDst + 1) y + _ + | overlaps dst src + -> case compare iDst iSrc of + LT -> moveBackwards arrDst iDst iSrc n + EQ -> return () + GT | (iDst - iSrc) * 2 < n + -> moveForwardsLargeOverlap arrDst iDst iSrc n + | otherwise + -> moveForwardsSmallOverlap arrDst iDst iSrc n + | otherwise -> G.basicUnsafeCopy dst src + + {-# INLINE basicClear #-} + basicClear v = G.set v uninitialised + +{-# INLINE moveBackwards #-} +moveBackwards :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () +moveBackwards !arr !dstOff !srcOff !len = + INTERNAL_CHECK(check) "moveBackwards" "not a backwards move" (dstOff < srcOff) + $ loopM len $ \ i -> readArray arr (srcOff + i) >>= writeArray arr (dstOff + i) + +{-# INLINE moveForwardsSmallOverlap #-} +-- Performs a move when dstOff > srcOff, optimized for when the overlap of the intervals is small. +moveForwardsSmallOverlap :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () +moveForwardsSmallOverlap !arr !dstOff !srcOff !len = + INTERNAL_CHECK(check) "moveForwardsSmallOverlap" "not a forward move" (dstOff > srcOff) + $ do + tmp <- newArray overlap uninitialised + loopM overlap $ \ i -> readArray arr (dstOff + i) >>= writeArray tmp i + loopM nonOverlap $ \ i -> readArray arr (srcOff + i) >>= writeArray arr (dstOff + i) + loopM overlap $ \ i -> readArray tmp i >>= writeArray arr (dstOff + nonOverlap + i) + where nonOverlap = dstOff - srcOff; overlap = len - nonOverlap + +-- Performs a move when dstOff > srcOff, optimized for when the overlap of the intervals is large. +moveForwardsLargeOverlap :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m () +moveForwardsLargeOverlap !arr !dstOff !srcOff !len = + INTERNAL_CHECK(check) "moveForwardsLargeOverlap" "not a forward move" (dstOff > srcOff) + $ do + queue <- newArray nonOverlap uninitialised + loopM nonOverlap $ \ i -> readArray arr (srcOff + i) >>= writeArray queue i + let mov !i !qTop = when (i < dstOff + len) $ do + x <- readArray arr i + y <- readArray queue qTop + writeArray arr i y + writeArray queue qTop x + mov (i+1) (if qTop + 1 >= nonOverlap then 0 else qTop + 1) + mov dstOff 0 + where nonOverlap = dstOff - srcOff + +{-# INLINE loopM #-} +loopM :: Monad m => Int -> (Int -> m a) -> m () +loopM !n k = let + go i = when (i < n) (k i >> go (i+1)) + in go 0 + +uninitialised :: a +uninitialised = error "Data.Vector.Mutable: uninitialised element" + +-- Length information +-- ------------------ + +-- | Length of the mutable vector. +length :: MVector s a -> Int +{-# INLINE length #-} +length = G.length + +-- | Check whether the vector is empty +null :: MVector s a -> Bool +{-# INLINE null #-} +null = G.null + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. +slice :: Int -> Int -> MVector s a -> MVector s a +{-# INLINE slice #-} +slice = G.slice + +take :: Int -> MVector s a -> MVector s a +{-# INLINE take #-} +take = G.take + +drop :: Int -> MVector s a -> MVector s a +{-# INLINE drop #-} +drop = G.drop + +{-# INLINE splitAt #-} +splitAt :: Int -> MVector s a -> (MVector s a, MVector s a) +splitAt = G.splitAt + +init :: MVector s a -> MVector s a +{-# INLINE init #-} +init = G.init + +tail :: MVector s a -> MVector s a +{-# INLINE tail #-} +tail = G.tail + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +unsafeSlice :: Int -- ^ starting index + -> Int -- ^ length of the slice + -> MVector s a + -> MVector s a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +unsafeTake :: Int -> MVector s a -> MVector s a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +unsafeDrop :: Int -> MVector s a -> MVector s a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +unsafeInit :: MVector s a -> MVector s a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +unsafeTail :: MVector s a -> MVector s a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +overlaps :: MVector s a -> MVector s a -> Bool +{-# INLINE overlaps #-} +overlaps = G.overlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +new :: PrimMonad m => Int -> m (MVector (PrimState m) a) +{-# INLINE new #-} +new = G.new + +-- | Create a mutable vector of the given length. The memory is not initialized. +unsafeNew :: PrimMonad m => Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew = G.unsafeNew + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +replicate :: PrimMonad m => Int -> a -> m (MVector (PrimState m) a) +{-# INLINE replicate #-} +replicate = G.replicate + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +replicateM :: PrimMonad m => Int -> m a -> m (MVector (PrimState m) a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | Create a copy of a mutable vector. +clone :: PrimMonad m => MVector (PrimState m) a -> m (MVector (PrimState m) a) +{-# INLINE clone #-} +clone = G.clone + +-- Growing +-- ------- + +-- | Grow a vector by the given number of elements. The number must be +-- positive. +grow :: PrimMonad m + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE grow #-} +grow = G.grow + +-- | Grow a vector by the given number of elements. The number must be +-- positive but this is not checked. +unsafeGrow :: PrimMonad m + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow = G.unsafeGrow + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- references to external objects. This is usually a noop for unboxed vectors. +clear :: PrimMonad m => MVector (PrimState m) a -> m () +{-# INLINE clear #-} +clear = G.clear + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. +read :: PrimMonad m => MVector (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read = G.read + +-- | Replace the element at the given position. +write :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE write #-} +write = G.write + +-- | Modify the element at the given position. +modify :: PrimMonad m => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE modify #-} +modify = G.modify + +-- | Swap the elements at the given positions. +swap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap = G.swap + + +-- | Yield the element at the given position. No bounds checks are performed. +unsafeRead :: PrimMonad m => MVector (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +unsafeRead = G.unsafeRead + +-- | Replace the element at the given position. No bounds checks are performed. +unsafeWrite :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE unsafeWrite #-} +unsafeWrite = G.unsafeWrite + +-- | Modify the element at the given position. No bounds checks are performed. +unsafeModify :: PrimMonad m => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE unsafeModify #-} +unsafeModify = G.unsafeModify + +-- | Swap the elements at the given positions. No bounds checks are performed. +unsafeSwap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE unsafeSwap #-} +unsafeSwap = G.unsafeSwap + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +set :: PrimMonad m => MVector (PrimState m) a -> a -> m () +{-# INLINE set #-} +set = G.set + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +copy :: PrimMonad m + => MVector (PrimState m) a -> MVector (PrimState m) a -> m () +{-# INLINE copy #-} +copy = G.copy + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. This is not checked. +unsafeCopy :: PrimMonad m => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | Move the contents of a vector. The two vectors must have the same +-- length. +-- +-- If the vectors do not overlap, then this is equivalent to 'copy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +move :: PrimMonad m + => MVector (PrimState m) a -> MVector (PrimState m) a -> m () +{-# INLINE move #-} +move = G.move + +-- | Move the contents of a vector. The two vectors must have the same +-- length, but this is not checked. +-- +-- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +unsafeMove :: PrimMonad m => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove = G.unsafeMove + +-- | Compute the next (lexicographically) permutation of given vector in-place. +-- Returns False when input is the last permtuation +nextPermutation :: (PrimMonad m,Ord e) => MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutation #-} +nextPermutation = G.nextPermutation diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Primitive.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Primitive.hs new file mode 100644 index 0000000000..ba18f9ba95 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Primitive.hs @@ -0,0 +1,1393 @@ +{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables, Rank2Types #-} + +-- | +-- Module : Data.Vector.Primitive +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Unboxed vectors of primitive types. The use of this module is not +-- recommended except in very special cases. Adaptive unboxed vectors defined +-- in "Data.Vector.Unboxed" are significantly more flexible at no performance +-- cost. +-- + +module Data.Vector.Primitive ( + -- * Primitive vectors + Vector(..), MVector(..), Prim, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + unsafeIndex, unsafeHead, unsafeLast, + + -- ** Monadic indexing + indexM, headM, lastM, + unsafeIndexM, unsafeHeadM, unsafeLastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, iterateNM, create, createT, + + -- ** Unfolding + unfoldr, unfoldrN, + unfoldrM, unfoldrNM, + constructN, constructrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update_, + unsafeUpd, unsafeUpdate_, + + -- ** Accumulations + accum, accumulate_, + unsafeAccum, unsafeAccumulate_, + + -- ** Permutations + reverse, backpermute, unsafeBackpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, mapM_, forM, forM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + + -- ** Monadic zipping + zipWithM, zipWithM_, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, uniq, + mapMaybe, imapMaybe, + filterM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, span, break, + + -- ** Searching + elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + + -- ** Specialised folds + all, any, + sum, product, + maximum, maximumBy, minimum, minimumBy, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, foldM', fold1M, fold1M', + foldM_, foldM'_, fold1M_, fold1M'_, + + -- * Prefix sums (scans) + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Other vector types + G.convert, + + -- ** Mutable vectors + freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy +) where + +import qualified Data.Vector.Generic as G +import Data.Vector.Primitive.Mutable ( MVector(..) ) +import qualified Data.Vector.Fusion.Bundle as Bundle +import Data.Primitive.ByteArray +import Data.Primitive ( Prim, sizeOf ) + +import Control.DeepSeq ( NFData(rnf) ) + +import Control.Monad ( liftM ) +import Control.Monad.ST ( ST ) +import Control.Monad.Primitive + +import Prelude hiding ( length, null, + replicate, (++), concat, + head, last, + init, tail, take, drop, splitAt, reverse, + map, concatMap, + zipWith, zipWith3, zip, zip3, unzip, unzip3, + filter, takeWhile, dropWhile, span, break, + elem, notElem, + foldl, foldl1, foldr, foldr1, + all, any, sum, product, minimum, maximum, + scanl, scanl1, scanr, scanr1, + enumFromTo, enumFromThenTo, + mapM, mapM_ ) + +import Data.Typeable ( Typeable ) +import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) +import Data.Semigroup ( Semigroup(..) ) + +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid ( Monoid(..) ) +import Data.Traversable ( Traversable ) +#endif + +#if __GLASGOW_HASKELL__ >= 708 +import qualified GHC.Exts as Exts +#endif + +-- | Unboxed vectors of primitive types +data Vector a = Vector {-# UNPACK #-} !Int + {-# UNPACK #-} !Int + {-# UNPACK #-} !ByteArray -- ^ offset, length, underlying byte array + deriving ( Typeable ) + +instance NFData (Vector a) where + rnf (Vector _ _ _) = () + +instance (Show a, Prim a) => Show (Vector a) where + showsPrec = G.showsPrec + +instance (Read a, Prim a) => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + +instance (Data a, Prim a) => Data (Vector a) where + gfoldl = G.gfoldl + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = G.mkType "Data.Vector.Primitive.Vector" + dataCast1 = G.dataCast + + +type instance G.Mutable Vector = MVector + +instance Prim a => G.Vector Vector a where + {-# INLINE basicUnsafeFreeze #-} + basicUnsafeFreeze (MVector i n marr) + = Vector i n `liftM` unsafeFreezeByteArray marr + + {-# INLINE basicUnsafeThaw #-} + basicUnsafeThaw (Vector i n arr) + = MVector i n `liftM` unsafeThawByteArray arr + + {-# INLINE basicLength #-} + basicLength (Vector _ n _) = n + + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice j n (Vector i _ arr) = Vector (i+j) n arr + + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM (Vector i _ arr) j = return $! indexByteArray arr (i+j) + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MVector i n dst) (Vector j _ src) + = copyByteArray dst (i*sz) src (j*sz) (n*sz) + where + sz = sizeOf (undefined :: a) + + {-# INLINE elemseq #-} + elemseq _ = seq + +-- See http://trac.haskell.org/vector/ticket/12 +instance (Prim a, Eq a) => Eq (Vector a) where + {-# INLINE (==) #-} + xs == ys = Bundle.eq (G.stream xs) (G.stream ys) + + {-# INLINE (/=) #-} + xs /= ys = not (Bundle.eq (G.stream xs) (G.stream ys)) + +-- See http://trac.haskell.org/vector/ticket/12 +instance (Prim a, Ord a) => Ord (Vector a) where + {-# INLINE compare #-} + compare xs ys = Bundle.cmp (G.stream xs) (G.stream ys) + + {-# INLINE (<) #-} + xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT + + {-# INLINE (<=) #-} + xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT + + {-# INLINE (>) #-} + xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT + + {-# INLINE (>=) #-} + xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT + +instance Prim a => Semigroup (Vector a) where + {-# INLINE (<>) #-} + (<>) = (++) + + {-# INLINE sconcat #-} + sconcat = G.concatNE + +instance Prim a => Monoid (Vector a) where + {-# INLINE mempty #-} + mempty = empty + + {-# INLINE mappend #-} + mappend = (++) + + {-# INLINE mconcat #-} + mconcat = concat + +#if __GLASGOW_HASKELL__ >= 708 + +instance Prim a => Exts.IsList (Vector a) where + type Item (Vector a) = a + fromList = fromList + fromListN = fromListN + toList = toList + +#endif +-- Length +-- ------ + +-- | /O(1)/ Yield the length of the vector +length :: Prim a => Vector a -> Int +{-# INLINE length #-} +length = G.length + +-- | /O(1)/ Test whether a vector is empty +null :: Prim a => Vector a -> Bool +{-# INLINE null #-} +null = G.null + +-- Indexing +-- -------- + +-- | O(1) Indexing +(!) :: Prim a => Vector a -> Int -> a +{-# INLINE (!) #-} +(!) = (G.!) + +-- | O(1) Safe indexing +(!?) :: Prim a => Vector a -> Int -> Maybe a +{-# INLINE (!?) #-} +(!?) = (G.!?) + +-- | /O(1)/ First element +head :: Prim a => Vector a -> a +{-# INLINE head #-} +head = G.head + +-- | /O(1)/ Last element +last :: Prim a => Vector a -> a +{-# INLINE last #-} +last = G.last + +-- | /O(1)/ Unsafe indexing without bounds checking +unsafeIndex :: Prim a => Vector a -> Int -> a +{-# INLINE unsafeIndex #-} +unsafeIndex = G.unsafeIndex + +-- | /O(1)/ First element without checking if the vector is empty +unsafeHead :: Prim a => Vector a -> a +{-# INLINE unsafeHead #-} +unsafeHead = G.unsafeHead + +-- | /O(1)/ Last element without checking if the vector is empty +unsafeLast :: Prim a => Vector a -> a +{-# INLINE unsafeLast #-} +unsafeLast = G.unsafeLast + +-- Monadic indexing +-- ---------------- + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the vector when necessary. +-- Suppose vector copying is implemented like this: +-- +-- > copy mv v = ... write mv i (v ! i) ... +-- +-- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ +-- would unnecessarily retain a reference to @v@ in each element written. +-- +-- With 'indexM', copying can be implemented like this instead: +-- +-- > copy mv v = ... do +-- > x <- indexM v i +-- > write mv i x +-- +-- Here, no references to @v@ are retained because indexing (but /not/ the +-- elements) is evaluated eagerly. +-- +indexM :: (Prim a, Monad m) => Vector a -> Int -> m a +{-# INLINE indexM #-} +indexM = G.indexM + +-- | /O(1)/ First element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +headM :: (Prim a, Monad m) => Vector a -> m a +{-# INLINE headM #-} +headM = G.headM + +-- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +lastM :: (Prim a, Monad m) => Vector a -> m a +{-# INLINE lastM #-} +lastM = G.lastM + +-- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an +-- explanation of why this is useful. +unsafeIndexM :: (Prim a, Monad m) => Vector a -> Int -> m a +{-# INLINE unsafeIndexM #-} +unsafeIndexM = G.unsafeIndexM + +-- | /O(1)/ First element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeHeadM :: (Prim a, Monad m) => Vector a -> m a +{-# INLINE unsafeHeadM #-} +unsafeHeadM = G.unsafeHeadM + +-- | /O(1)/ Last element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeLastM :: (Prim a, Monad m) => Vector a -> m a +{-# INLINE unsafeLastM #-} +unsafeLastM = G.unsafeLastM + +-- Extracting subvectors (slicing) +-- ------------------------------- + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Prim a + => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE slice #-} +slice = G.slice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty. +init :: Prim a => Vector a -> Vector a +{-# INLINE init #-} +init = G.init + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty. +tail :: Prim a => Vector a -> Vector a +{-# INLINE tail #-} +tail = G.tail + +-- | /O(1)/ Yield at the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case it is returned unchanged. +take :: Prim a => Int -> Vector a -> Vector a +{-# INLINE take #-} +take = G.take + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case an empty vector is returned. +drop :: Prim a => Int -> Vector a -> Vector a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ +-- but slightly more efficient. +{-# INLINE splitAt #-} +splitAt :: Prim a => Int -> Vector a -> (Vector a, Vector a) +splitAt = G.splitAt + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must +-- contain at least @i+n@ elements but this is not checked. +unsafeSlice :: Prim a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty but this is not checked. +unsafeInit :: Prim a => Vector a -> Vector a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty but this is not checked. +unsafeTail :: Prim a => Vector a -> Vector a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector must +-- contain at least @n@ elements but this is not checked. +unsafeTake :: Prim a => Int -> Vector a -> Vector a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector +-- must contain at least @n@ elements but this is not checked. +unsafeDrop :: Prim a => Int -> Vector a -> Vector a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- Initialisation +-- -------------- + +-- | /O(1)/ Empty vector +empty :: Prim a => Vector a +{-# INLINE empty #-} +empty = G.empty + +-- | /O(1)/ Vector with exactly one element +singleton :: Prim a => a -> Vector a +{-# INLINE singleton #-} +singleton = G.singleton + +-- | /O(n)/ Vector of the given length with the same value in each position +replicate :: Prim a => Int -> a -> Vector a +{-# INLINE replicate #-} +replicate = G.replicate + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index +generate :: Prim a => Int -> (Int -> a) -> Vector a +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Apply function n times to value. Zeroth element is original value. +iterateN :: Prim a => Int -> (a -> a) -> a -> Vector a +{-# INLINE iterateN #-} +iterateN = G.iterateN + +-- Unfolding +-- --------- + +-- | /O(n)/ Construct a vector by repeatedly applying the generator function +-- to a seed. The generator function yields 'Just' the next element and the +-- new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 +-- > = <10,9,8,7,6,5,4,3,2,1> +unfoldr :: Prim a => (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldr #-} +unfoldr = G.unfoldr + +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> +unfoldrN :: Prim a => Int -> (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldrN #-} +unfoldrN = G.unfoldrN + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Prim a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Prim a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in f <a,b,c> +-- +constructN :: Prim a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in f <c,b,a> +-- +constructrN :: Prim a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN + +-- Enumeration +-- ----------- + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ +-- etc. This operation is usually more efficient than 'enumFromTo'. +-- +-- > enumFromN 5 3 = <5,6,7> +enumFromN :: (Prim a, Num a) => a -> Int -> Vector a +{-# INLINE enumFromN #-} +enumFromN = G.enumFromN + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, +-- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. +-- +-- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> +enumFromStepN :: (Prim a, Num a) => a -> a -> Int -> Vector a +{-# INLINE enumFromStepN #-} +enumFromStepN = G.enumFromStepN + +-- | /O(n)/ Enumerate values from @x@ to @y@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromN' instead. +enumFromTo :: (Prim a, Enum a) => a -> a -> Vector a +{-# INLINE enumFromTo #-} +enumFromTo = G.enumFromTo + +-- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Prim a, Enum a) => a -> a -> a -> Vector a +{-# INLINE enumFromThenTo #-} +enumFromThenTo = G.enumFromThenTo + +-- Concatenation +-- ------------- + +-- | /O(n)/ Prepend an element +cons :: Prim a => a -> Vector a -> Vector a +{-# INLINE cons #-} +cons = G.cons + +-- | /O(n)/ Append an element +snoc :: Prim a => Vector a -> a -> Vector a +{-# INLINE snoc #-} +snoc = G.snoc + +infixr 5 ++ +-- | /O(m+n)/ Concatenate two vectors +(++) :: Prim a => Vector a -> Vector a -> Vector a +{-# INLINE (++) #-} +(++) = (G.++) + +-- | /O(n)/ Concatenate all vectors in the list +concat :: Prim a => [Vector a] -> Vector a +{-# INLINE concat #-} +concat = G.concat + +-- Monadic initialisation +-- ---------------------- + +-- | /O(n)/ Execute the monadic action the given number of times and store the +-- results in a vector. +replicateM :: (Monad m, Prim a) => Int -> m a -> m (Vector a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +generateM :: (Monad m, Prim a) => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: (Monad m, Prim a) => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + +-- | Execute the monadic action and freeze the resulting vector. +-- +-- @ +-- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> +-- @ +create :: Prim a => (forall s. ST s (MVector s a)) -> Vector a +{-# INLINE create #-} +-- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 +create p = G.create p + +-- | Execute the monadic action and freeze the resulting vectors. +createT :: (Traversable f, Prim a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + +-- Restricting memory usage +-- ------------------------ + +-- | /O(n)/ Yield the argument but force it not to retain any extra memory, +-- possibly by copying it. +-- +-- This is especially useful when dealing with slices. For example: +-- +-- > force (slice 0 2 <huge vector>) +-- +-- Here, the slice retains a reference to the huge vector. Forcing it creates +-- a copy of just the elements that belong to the slice and allows the huge +-- vector to be garbage collected. +force :: Prim a => Vector a -> Vector a +{-# INLINE force #-} +force = G.force + +-- Bulk updates +-- ------------ + +-- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector +-- element at position @i@ by @a@. +-- +-- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> +-- +(//) :: Prim a => Vector a -- ^ initial vector (of length @m@) + -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE (//) #-} +(//) = (G.//) + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @a@ from the value vector, replace the element of the +-- initial vector at position @i@ by @a@. +-- +-- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> +-- +update_ :: Prim a + => Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector a -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE update_ #-} +update_ = G.update_ + +-- | Same as ('//') but without bounds checking. +unsafeUpd :: Prim a => Vector a -> [(Int, a)] -> Vector a +{-# INLINE unsafeUpd #-} +unsafeUpd = G.unsafeUpd + +-- | Same as 'update_' but without bounds checking. +unsafeUpdate_ :: Prim a => Vector a -> Vector Int -> Vector a -> Vector a +{-# INLINE unsafeUpdate_ #-} +unsafeUpdate_ = G.unsafeUpdate_ + +-- Accumulations +-- ------------- + +-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element +-- @a@ at position @i@ by @f a b@. +-- +-- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> +accum :: Prim a + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accum #-} +accum = G.accum + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the the value vector, +-- replace the element of the initial vector at +-- position @i@ by @f a b@. +-- +-- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> +-- +accumulate_ :: (Prim a, Prim b) + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector b -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE accumulate_ #-} +accumulate_ = G.accumulate_ + +-- | Same as 'accum' but without bounds checking. +unsafeAccum :: Prim a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a +{-# INLINE unsafeAccum #-} +unsafeAccum = G.unsafeAccum + +-- | Same as 'accumulate_' but without bounds checking. +unsafeAccumulate_ :: (Prim a, Prim b) => + (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a +{-# INLINE unsafeAccumulate_ #-} +unsafeAccumulate_ = G.unsafeAccumulate_ + +-- Permutations +-- ------------ + +-- | /O(n)/ Reverse a vector +reverse :: Prim a => Vector a -> Vector a +{-# INLINE reverse #-} +reverse = G.reverse + +-- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the +-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is +-- often much more efficient. +-- +-- > backpermute <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a> +backpermute :: Prim a => Vector a -> Vector Int -> Vector a +{-# INLINE backpermute #-} +backpermute = G.backpermute + +-- | Same as 'backpermute' but without bounds checking. +unsafeBackpermute :: Prim a => Vector a -> Vector Int -> Vector a +{-# INLINE unsafeBackpermute #-} +unsafeBackpermute = G.unsafeBackpermute + +-- Safe destructive updates +-- ------------------------ + +-- | Apply a destructive operation to a vector. The operation will be +-- performed in place if it is safe to do so and will modify a copy of the +-- vector otherwise. +-- +-- @ +-- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> +-- @ +modify :: Prim a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a +{-# INLINE modify #-} +modify p = G.modify p + +-- Mapping +-- ------- + +-- | /O(n)/ Map a function over a vector +map :: (Prim a, Prim b) => (a -> b) -> Vector a -> Vector b +{-# INLINE map #-} +map = G.map + +-- | /O(n)/ Apply a function to every element of a vector and its index +imap :: (Prim a, Prim b) => (Int -> a -> b) -> Vector a -> Vector b +{-# INLINE imap #-} +imap = G.imap + +-- | Map a function over a vector and concatenate the results. +concatMap :: (Prim a, Prim b) => (a -> Vector b) -> Vector a -> Vector b +{-# INLINE concatMap #-} +concatMap = G.concatMap + +-- Monadic mapping +-- --------------- + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results +mapM :: (Monad m, Prim a, Prim b) => (a -> m b) -> Vector a -> m (Vector b) +{-# INLINE mapM #-} +mapM = G.mapM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results +mapM_ :: (Monad m, Prim a) => (a -> m b) -> Vector a -> m () +{-# INLINE mapM_ #-} +mapM_ = G.mapM_ + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results. Equivalent to @flip 'mapM'@. +forM :: (Monad m, Prim a, Prim b) => Vector a -> (a -> m b) -> m (Vector b) +{-# INLINE forM #-} +forM = G.forM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results. Equivalent to @flip 'mapM_'@. +forM_ :: (Monad m, Prim a) => Vector a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- Zipping +-- ------- + +-- | /O(min(m,n))/ Zip two vectors with the given function. +zipWith :: (Prim a, Prim b, Prim c) + => (a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE zipWith #-} +zipWith = G.zipWith + +-- | Zip three vectors with the given function. +zipWith3 :: (Prim a, Prim b, Prim c, Prim d) + => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE zipWith3 #-} +zipWith3 = G.zipWith3 + +zipWith4 :: (Prim a, Prim b, Prim c, Prim d, Prim e) + => (a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE zipWith4 #-} +zipWith4 = G.zipWith4 + +zipWith5 :: (Prim a, Prim b, Prim c, Prim d, Prim e, + Prim f) + => (a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE zipWith5 #-} +zipWith5 = G.zipWith5 + +zipWith6 :: (Prim a, Prim b, Prim c, Prim d, Prim e, + Prim f, Prim g) + => (a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE zipWith6 #-} +zipWith6 = G.zipWith6 + +-- | /O(min(m,n))/ Zip two vectors with a function that also takes the +-- elements' indices. +izipWith :: (Prim a, Prim b, Prim c) + => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE izipWith #-} +izipWith = G.izipWith + +-- | Zip three vectors and their indices with the given function. +izipWith3 :: (Prim a, Prim b, Prim c, Prim d) + => (Int -> a -> b -> c -> d) + -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE izipWith3 #-} +izipWith3 = G.izipWith3 + +izipWith4 :: (Prim a, Prim b, Prim c, Prim d, Prim e) + => (Int -> a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE izipWith4 #-} +izipWith4 = G.izipWith4 + +izipWith5 :: (Prim a, Prim b, Prim c, Prim d, Prim e, + Prim f) + => (Int -> a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE izipWith5 #-} +izipWith5 = G.izipWith5 + +izipWith6 :: (Prim a, Prim b, Prim c, Prim d, Prim e, + Prim f, Prim g) + => (Int -> a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE izipWith6 #-} +izipWith6 = G.izipWith6 + +-- Monadic zipping +-- --------------- + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a +-- vector of results +zipWithM :: (Monad m, Prim a, Prim b, Prim c) + => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +{-# INLINE zipWithM #-} +zipWithM = G.zipWithM + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the +-- results +zipWithM_ :: (Monad m, Prim a, Prim b) + => (a -> b -> m c) -> Vector a -> Vector b -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ = G.zipWithM_ + +-- Filtering +-- --------- + +-- | /O(n)/ Drop elements that do not satisfy the predicate +filter :: Prim a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE filter #-} +filter = G.filter + +-- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to +-- values and their indices +ifilter :: Prim a => (Int -> a -> Bool) -> Vector a -> Vector a +{-# INLINE ifilter #-} +ifilter = G.ifilter + +-- | /O(n)/ Drop repeated adjacent elements. +uniq :: (Prim a, Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + +-- | /O(n)/ Drop elements when predicate returns Nothing +mapMaybe :: (Prim a, Prim b) => (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing +imapMaybe :: (Prim a, Prim b) => (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + +-- | /O(n)/ Drop elements that do not satisfy the monadic predicate +filterM :: (Monad m, Prim a) => (a -> m Bool) -> Vector a -> m (Vector a) +{-# INLINE filterM #-} +filterM = G.filterM + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate +-- without copying. +takeWhile :: Prim a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE takeWhile #-} +takeWhile = G.takeWhile + +-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate +-- without copying. +dropWhile :: Prim a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE dropWhile #-} +dropWhile = G.dropWhile + +-- Parititioning +-- ------------- + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. The +-- relative order of the elements is preserved at the cost of a sometimes +-- reduced performance compared to 'unstablePartition'. +partition :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE partition #-} +partition = G.partition + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. +-- The order of the elements is not preserved but the operation is often +-- faster than 'partition'. +unstablePartition :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE unstablePartition #-} +unstablePartition = G.unstablePartition + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +span :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE span #-} +span = G.span + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +break :: Prim a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE break #-} +break = G.break + +-- Searching +-- --------- + +infix 4 `elem` +-- | /O(n)/ Check if the vector contains an element +elem :: (Prim a, Eq a) => a -> Vector a -> Bool +{-# INLINE elem #-} +elem = G.elem + +infix 4 `notElem` +-- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') +notElem :: (Prim a, Eq a) => a -> Vector a -> Bool +{-# INLINE notElem #-} +notElem = G.notElem + +-- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' +-- if no such element exists. +find :: Prim a => (a -> Bool) -> Vector a -> Maybe a +{-# INLINE find #-} +find = G.find + +-- | /O(n)/ Yield 'Just' the index of the first element matching the predicate +-- or 'Nothing' if no such element exists. +findIndex :: Prim a => (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndex #-} +findIndex = G.findIndex + +-- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending +-- order. +findIndices :: Prim a => (a -> Bool) -> Vector a -> Vector Int +{-# INLINE findIndices #-} +findIndices = G.findIndices + +-- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or +-- 'Nothing' if the vector does not contain the element. This is a specialised +-- version of 'findIndex'. +elemIndex :: (Prim a, Eq a) => a -> Vector a -> Maybe Int +{-# INLINE elemIndex #-} +elemIndex = G.elemIndex + +-- | /O(n)/ Yield the indices of all occurences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +elemIndices :: (Prim a, Eq a) => a -> Vector a -> Vector Int +{-# INLINE elemIndices #-} +elemIndices = G.elemIndices + +-- Folding +-- ------- + +-- | /O(n)/ Left fold +foldl :: Prim b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Left fold on non-empty vectors +foldl1 :: Prim a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1 #-} +foldl1 = G.foldl1 + +-- | /O(n)/ Left fold with strict accumulator +foldl' :: Prim b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Left fold on non-empty vectors with strict accumulator +foldl1' :: Prim a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1' #-} +foldl1' = G.foldl1' + +-- | /O(n)/ Right fold +foldr :: Prim a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Right fold on non-empty vectors +foldr1 :: Prim a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1 #-} +foldr1 = G.foldr1 + +-- | /O(n)/ Right fold with a strict accumulator +foldr' :: Prim a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Right fold on non-empty vectors with strict accumulator +foldr1' :: Prim a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1' #-} +foldr1' = G.foldr1' + +-- | /O(n)/ Left fold (function applied to each element and its index) +ifoldl :: Prim b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Left fold with strict accumulator (function applied to each element +-- and its index) +ifoldl' :: Prim b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Right fold (function applied to each element and its index) +ifoldr :: Prim a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Right fold with strict accumulator (function applied to each +-- element and its index) +ifoldr' :: Prim a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- Specialised folds +-- ----------------- + +-- | /O(n)/ Check if all elements satisfy the predicate. +all :: Prim a => (a -> Bool) -> Vector a -> Bool +{-# INLINE all #-} +all = G.all + +-- | /O(n)/ Check if any element satisfies the predicate. +any :: Prim a => (a -> Bool) -> Vector a -> Bool +{-# INLINE any #-} +any = G.any + +-- | /O(n)/ Compute the sum of the elements +sum :: (Prim a, Num a) => Vector a -> a +{-# INLINE sum #-} +sum = G.sum + +-- | /O(n)/ Compute the produce of the elements +product :: (Prim a, Num a) => Vector a -> a +{-# INLINE product #-} +product = G.product + +-- | /O(n)/ Yield the maximum element of the vector. The vector may not be +-- empty. +maximum :: (Prim a, Ord a) => Vector a -> a +{-# INLINE maximum #-} +maximum = G.maximum + +-- | /O(n)/ Yield the maximum element of the vector according to the given +-- comparison function. The vector may not be empty. +maximumBy :: Prim a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE maximumBy #-} +maximumBy = G.maximumBy + +-- | /O(n)/ Yield the minimum element of the vector. The vector may not be +-- empty. +minimum :: (Prim a, Ord a) => Vector a -> a +{-# INLINE minimum #-} +minimum = G.minimum + +-- | /O(n)/ Yield the minimum element of the vector according to the given +-- comparison function. The vector may not be empty. +minimumBy :: Prim a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE minimumBy #-} +minimumBy = G.minimumBy + +-- | /O(n)/ Yield the index of the maximum element of the vector. The vector +-- may not be empty. +maxIndex :: (Prim a, Ord a) => Vector a -> Int +{-# INLINE maxIndex #-} +maxIndex = G.maxIndex + +-- | /O(n)/ Yield the index of the maximum element of the vector according to +-- the given comparison function. The vector may not be empty. +maxIndexBy :: Prim a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE maxIndexBy #-} +maxIndexBy = G.maxIndexBy + +-- | /O(n)/ Yield the index of the minimum element of the vector. The vector +-- may not be empty. +minIndex :: (Prim a, Ord a) => Vector a -> Int +{-# INLINE minIndex #-} +minIndex = G.minIndex + +-- | /O(n)/ Yield the index of the minimum element of the vector according to +-- the given comparison function. The vector may not be empty. +minIndexBy :: Prim a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE minIndexBy #-} +minIndexBy = G.minIndexBy + +-- Monadic folds +-- ------------- + +-- | /O(n)/ Monadic fold +foldM :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold over non-empty vectors +fold1M :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M #-} +fold1M = G.fold1M + +-- | /O(n)/ Monadic fold with strict accumulator +foldM' :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +fold1M' :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M' #-} +fold1M' = G.fold1M' + +-- | /O(n)/ Monadic fold that discards the result +foldM_ :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold over non-empty vectors that discards the result +fold1M_ :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +foldM'_ :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +-- that discards the result +fold1M'_ :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + +-- Prefix sums (scans) +-- ------------------- + +-- | /O(n)/ Prescan +-- +-- @ +-- prescanl f z = 'init' . 'scanl' f z +-- @ +-- +-- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ +-- +prescanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl #-} +prescanl = G.prescanl + +-- | /O(n)/ Prescan with strict accumulator +prescanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl' #-} +prescanl' = G.prescanl' + +-- | /O(n)/ Scan +-- +-- @ +-- postscanl f z = 'tail' . 'scanl' f z +-- @ +-- +-- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ +-- +postscanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl #-} +postscanl = G.postscanl + +-- | /O(n)/ Scan with strict accumulator +postscanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl' #-} +postscanl' = G.postscanl' + +-- | /O(n)/ Haskell-style scan +-- +-- > scanl f z <x1,...,xn> = <y1,...,y(n+1)> +-- > where y1 = z +-- > yi = f y(i-1) x(i-1) +-- +-- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@ +-- +scanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl #-} +scanl = G.scanl + +-- | /O(n)/ Haskell-style scan with strict accumulator +scanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl' #-} +scanl' = G.scanl' + +-- | /O(n)/ Scan over a non-empty vector +-- +-- > scanl f <x1,...,xn> = <y1,...,yn> +-- > where y1 = x1 +-- > yi = f y(i-1) xi +-- +scanl1 :: Prim a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1 #-} +scanl1 = G.scanl1 + +-- | /O(n)/ Scan over a non-empty vector with a strict accumulator +scanl1' :: Prim a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1' #-} +scanl1' = G.scanl1' + +-- | /O(n)/ Right-to-left prescan +-- +-- @ +-- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' +-- @ +-- +prescanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr #-} +prescanr = G.prescanr + +-- | /O(n)/ Right-to-left prescan with strict accumulator +prescanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr' #-} +prescanr' = G.prescanr' + +-- | /O(n)/ Right-to-left scan +postscanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr #-} +postscanr = G.postscanr + +-- | /O(n)/ Right-to-left scan with strict accumulator +postscanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr' #-} +postscanr' = G.postscanr' + +-- | /O(n)/ Right-to-left Haskell-style scan +scanr :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr #-} +scanr = G.scanr + +-- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator +scanr' :: (Prim a, Prim b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr' #-} +scanr' = G.scanr' + +-- | /O(n)/ Right-to-left scan over a non-empty vector +scanr1 :: Prim a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1 #-} +scanr1 = G.scanr1 + +-- | /O(n)/ Right-to-left scan over a non-empty vector with a strict +-- accumulator +scanr1' :: Prim a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1' #-} +scanr1' = G.scanr1' + +-- Conversions - Lists +-- ------------------------ + +-- | /O(n)/ Convert a vector to a list +toList :: Prim a => Vector a -> [a] +{-# INLINE toList #-} +toList = G.toList + +-- | /O(n)/ Convert a list to a vector +fromList :: Prim a => [a] -> Vector a +{-# INLINE fromList #-} +fromList = G.fromList + +-- | /O(n)/ Convert the first @n@ elements of a list to a vector +-- +-- @ +-- fromListN n xs = 'fromList' ('take' n xs) +-- @ +fromListN :: Prim a => Int -> [a] -> Vector a +{-# INLINE fromListN #-} +fromListN = G.fromListN + +-- Conversions - Mutable vectors +-- ----------------------------- + +-- | /O(1)/ Unsafe convert a mutable vector to an immutable one without +-- copying. The mutable vector may not be used after this operation. +unsafeFreeze :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE unsafeFreeze #-} +unsafeFreeze = G.unsafeFreeze + +-- | /O(1)/ Unsafely convert an immutable vector to a mutable one without +-- copying. The immutable vector may not be used after this operation. +unsafeThaw :: (Prim a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE unsafeThaw #-} +unsafeThaw = G.unsafeThaw + +-- | /O(n)/ Yield a mutable copy of the immutable vector. +thaw :: (Prim a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE thaw #-} +thaw = G.thaw + +-- | /O(n)/ Yield an immutable copy of the mutable vector. +freeze :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE freeze #-} +freeze = G.freeze + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. This is not checked. +unsafeCopy + :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. +copy :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () +{-# INLINE copy #-} +copy = G.copy diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Primitive/Mutable.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Primitive/Mutable.hs new file mode 100644 index 0000000000..33aca812e2 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Primitive/Mutable.hs @@ -0,0 +1,366 @@ +{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-} + +-- | +-- Module : Data.Vector.Primitive.Mutable +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Mutable primitive vectors. +-- + +module Data.Vector.Primitive.Mutable ( + -- * Mutable vectors of primitive types + MVector(..), IOVector, STVector, Prim, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, clone, + + -- ** Growing + grow, unsafeGrow, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, write, modify, swap, + unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, + + -- * Modifying vectors + nextPermutation, + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove +) where + +import qualified Data.Vector.Generic.Mutable as G +import Data.Primitive.ByteArray +import Data.Primitive ( Prim, sizeOf ) +import Data.Word ( Word8 ) +import Control.Monad.Primitive +import Control.Monad ( liftM ) + +import Control.DeepSeq ( NFData(rnf) ) + +import Prelude hiding ( length, null, replicate, reverse, map, read, + take, drop, splitAt, init, tail ) + +import Data.Typeable ( Typeable ) + +-- Data.Vector.Internal.Check is unnecessary +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- | Mutable vectors of primitive types. +data MVector s a = MVector {-# UNPACK #-} !Int + {-# UNPACK #-} !Int + {-# UNPACK #-} !(MutableByteArray s) -- ^ offset, length, underlying mutable byte array + deriving ( Typeable ) + +type IOVector = MVector RealWorld +type STVector s = MVector s + +instance NFData (MVector s a) where + rnf (MVector _ _ _) = () + +instance Prim a => G.MVector MVector a where + basicLength (MVector _ n _) = n + basicUnsafeSlice j m (MVector i _ arr) + = MVector (i+j) m arr + + {-# INLINE basicOverlaps #-} + basicOverlaps (MVector i m arr1) (MVector j n arr2) + = sameMutableByteArray arr1 arr2 + && (between i j (j+n) || between j i (i+m)) + where + between x y z = x >= y && x < z + + {-# INLINE basicUnsafeNew #-} + basicUnsafeNew n + | n < 0 = error $ "Primitive.basicUnsafeNew: negative length: " ++ show n + | n > mx = error $ "Primitive.basicUnsafeNew: length to large: " ++ show n + | otherwise = MVector 0 n `liftM` newByteArray (n * size) + where + size = sizeOf (undefined :: a) + mx = maxBound `div` size :: Int + + {-# INLINE basicInitialize #-} + basicInitialize (MVector off n v) = + setByteArray v (off * size) (n * size) (0 :: Word8) + where + size = sizeOf (undefined :: a) + + + {-# INLINE basicUnsafeRead #-} + basicUnsafeRead (MVector i _ arr) j = readByteArray arr (i+j) + + {-# INLINE basicUnsafeWrite #-} + basicUnsafeWrite (MVector i _ arr) j x = writeByteArray arr (i+j) x + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MVector i n dst) (MVector j _ src) + = copyMutableByteArray dst (i*sz) src (j*sz) (n*sz) + where + sz = sizeOf (undefined :: a) + + {-# INLINE basicUnsafeMove #-} + basicUnsafeMove (MVector i n dst) (MVector j _ src) + = moveByteArray dst (i*sz) src (j*sz) (n * sz) + where + sz = sizeOf (undefined :: a) + + {-# INLINE basicSet #-} + basicSet (MVector i n arr) x = setByteArray arr i n x + +-- Length information +-- ------------------ + +-- | Length of the mutable vector. +length :: Prim a => MVector s a -> Int +{-# INLINE length #-} +length = G.length + +-- | Check whether the vector is empty +null :: Prim a => MVector s a -> Bool +{-# INLINE null #-} +null = G.null + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. +slice :: Prim a => Int -> Int -> MVector s a -> MVector s a +{-# INLINE slice #-} +slice = G.slice + +take :: Prim a => Int -> MVector s a -> MVector s a +{-# INLINE take #-} +take = G.take + +drop :: Prim a => Int -> MVector s a -> MVector s a +{-# INLINE drop #-} +drop = G.drop + +splitAt :: Prim a => Int -> MVector s a -> (MVector s a, MVector s a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +init :: Prim a => MVector s a -> MVector s a +{-# INLINE init #-} +init = G.init + +tail :: Prim a => MVector s a -> MVector s a +{-# INLINE tail #-} +tail = G.tail + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +unsafeSlice :: Prim a + => Int -- ^ starting index + -> Int -- ^ length of the slice + -> MVector s a + -> MVector s a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +unsafeTake :: Prim a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +unsafeDrop :: Prim a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +unsafeInit :: Prim a => MVector s a -> MVector s a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +unsafeTail :: Prim a => MVector s a -> MVector s a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +overlaps :: Prim a => MVector s a -> MVector s a -> Bool +{-# INLINE overlaps #-} +overlaps = G.overlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +new :: (PrimMonad m, Prim a) => Int -> m (MVector (PrimState m) a) +{-# INLINE new #-} +new = G.new + +-- | Create a mutable vector of the given length. The memory is not initialized. +unsafeNew :: (PrimMonad m, Prim a) => Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew = G.unsafeNew + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +replicate :: (PrimMonad m, Prim a) => Int -> a -> m (MVector (PrimState m) a) +{-# INLINE replicate #-} +replicate = G.replicate + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +replicateM :: (PrimMonad m, Prim a) => Int -> m a -> m (MVector (PrimState m) a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | Create a copy of a mutable vector. +clone :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -> m (MVector (PrimState m) a) +{-# INLINE clone #-} +clone = G.clone + +-- Growing +-- ------- + +-- | Grow a vector by the given number of elements. The number must be +-- positive. +grow :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE grow #-} +grow = G.grow + +-- | Grow a vector by the given number of elements. The number must be +-- positive but this is not checked. +unsafeGrow :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow = G.unsafeGrow + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- references to external objects. This is usually a noop for unboxed vectors. +clear :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> m () +{-# INLINE clear #-} +clear = G.clear + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. +read :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read = G.read + +-- | Replace the element at the given position. +write :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE write #-} +write = G.write + +-- | Modify the element at the given position. +modify :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE modify #-} +modify = G.modify + +-- | Swap the elements at the given positions. +swap :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap = G.swap + + +-- | Yield the element at the given position. No bounds checks are performed. +unsafeRead :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +unsafeRead = G.unsafeRead + +-- | Replace the element at the given position. No bounds checks are performed. +unsafeWrite + :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE unsafeWrite #-} +unsafeWrite = G.unsafeWrite + +-- | Modify the element at the given position. No bounds checks are performed. +unsafeModify :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE unsafeModify #-} +unsafeModify = G.unsafeModify + +-- | Swap the elements at the given positions. No bounds checks are performed. +unsafeSwap + :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE unsafeSwap #-} +unsafeSwap = G.unsafeSwap + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +set :: (PrimMonad m, Prim a) => MVector (PrimState m) a -> a -> m () +{-# INLINE set #-} +set = G.set + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +copy :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE copy #-} +copy = G.copy + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. This is not checked. +unsafeCopy :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | Move the contents of a vector. The two vectors must have the same +-- length. +-- +-- If the vectors do not overlap, then this is equivalent to 'copy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +move :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -> MVector (PrimState m) a -> m () +{-# INLINE move #-} +move = G.move + +-- | Move the contents of a vector. The two vectors must have the same +-- length, but this is not checked. +-- +-- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +unsafeMove :: (PrimMonad m, Prim a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove = G.unsafeMove + +-- | Compute the next (lexicographically) permutation of given vector in-place. +-- Returns False when input is the last permtuation +nextPermutation :: (PrimMonad m,Ord e,Prim e) => MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutation #-} +nextPermutation = G.nextPermutation diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable.hs new file mode 100644 index 0000000000..30c9a4615c --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable.hs @@ -0,0 +1,1489 @@ +{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, Rank2Types, ScopedTypeVariables #-} + +-- | +-- Module : Data.Vector.Storable +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- 'Storable'-based vectors. +-- + +module Data.Vector.Storable ( + -- * Storable vectors + Vector, MVector(..), Storable, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + unsafeIndex, unsafeHead, unsafeLast, + + -- ** Monadic indexing + indexM, headM, lastM, + unsafeIndexM, unsafeHeadM, unsafeLastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, iterateNM, create, createT, + + -- ** Unfolding + unfoldr, unfoldrN, + unfoldrM, unfoldrNM, + constructN, constructrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update_, + unsafeUpd, unsafeUpdate_, + + -- ** Accumulations + accum, accumulate_, + unsafeAccum, unsafeAccumulate_, + + -- ** Permutations + reverse, backpermute, unsafeBackpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, mapM_, forM, forM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + + -- ** Monadic zipping + zipWithM, zipWithM_, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, uniq, + mapMaybe, imapMaybe, + filterM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, span, break, + + -- ** Searching + elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + + -- ** Specialised folds + all, any, and, or, + sum, product, + maximum, maximumBy, minimum, minimumBy, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, foldM', fold1M, fold1M', + foldM_, foldM'_, fold1M_, fold1M'_, + + -- * Prefix sums (scans) + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Other vector types + G.convert, unsafeCast, + + -- ** Mutable vectors + freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy, + + -- * Raw pointers + unsafeFromForeignPtr, unsafeFromForeignPtr0, + unsafeToForeignPtr, unsafeToForeignPtr0, + unsafeWith +) where + +import qualified Data.Vector.Generic as G +import Data.Vector.Storable.Mutable ( MVector(..) ) +import Data.Vector.Storable.Internal +import qualified Data.Vector.Fusion.Bundle as Bundle + +import Foreign.Storable +import Foreign.ForeignPtr +import Foreign.Ptr +import Foreign.Marshal.Array ( advancePtr, copyArray ) + +import Control.DeepSeq ( NFData(rnf) ) + +import Control.Monad.ST ( ST ) +import Control.Monad.Primitive + +import Prelude hiding ( length, null, + replicate, (++), concat, + head, last, + init, tail, take, drop, splitAt, reverse, + map, concatMap, + zipWith, zipWith3, zip, zip3, unzip, unzip3, + filter, takeWhile, dropWhile, span, break, + elem, notElem, + foldl, foldl1, foldr, foldr1, + all, any, and, or, sum, product, minimum, maximum, + scanl, scanl1, scanr, scanr1, + enumFromTo, enumFromThenTo, + mapM, mapM_ ) + +import Data.Typeable ( Typeable ) +import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) +import Data.Semigroup ( Semigroup(..) ) + +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid ( Monoid(..) ) +import Data.Traversable ( Traversable ) +#endif + +#if __GLASGOW_HASKELL__ >= 708 +import qualified GHC.Exts as Exts +#endif + +-- Data.Vector.Internal.Check is unused +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- | 'Storable'-based vectors +data Vector a = Vector {-# UNPACK #-} !Int + {-# UNPACK #-} !(ForeignPtr a) + deriving ( Typeable ) + +instance NFData (Vector a) where + rnf (Vector _ _) = () + +instance (Show a, Storable a) => Show (Vector a) where + showsPrec = G.showsPrec + +instance (Read a, Storable a) => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + +instance (Data a, Storable a) => Data (Vector a) where + gfoldl = G.gfoldl + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = G.mkType "Data.Vector.Storable.Vector" + dataCast1 = G.dataCast + +type instance G.Mutable Vector = MVector + +instance Storable a => G.Vector Vector a where + {-# INLINE basicUnsafeFreeze #-} + basicUnsafeFreeze (MVector n fp) = return $ Vector n fp + + {-# INLINE basicUnsafeThaw #-} + basicUnsafeThaw (Vector n fp) = return $ MVector n fp + + {-# INLINE basicLength #-} + basicLength (Vector n _) = n + + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice i n (Vector _ fp) = Vector n (updPtr (`advancePtr` i) fp) + + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM (Vector _ fp) i = return + . unsafeInlineIO + $ withForeignPtr fp $ \p -> + peekElemOff p i + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MVector n fp) (Vector _ fq) + = unsafePrimToPrim + $ withForeignPtr fp $ \p -> + withForeignPtr fq $ \q -> + copyArray p q n + + {-# INLINE elemseq #-} + elemseq _ = seq + +-- See http://trac.haskell.org/vector/ticket/12 +instance (Storable a, Eq a) => Eq (Vector a) where + {-# INLINE (==) #-} + xs == ys = Bundle.eq (G.stream xs) (G.stream ys) + + {-# INLINE (/=) #-} + xs /= ys = not (Bundle.eq (G.stream xs) (G.stream ys)) + +-- See http://trac.haskell.org/vector/ticket/12 +instance (Storable a, Ord a) => Ord (Vector a) where + {-# INLINE compare #-} + compare xs ys = Bundle.cmp (G.stream xs) (G.stream ys) + + {-# INLINE (<) #-} + xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT + + {-# INLINE (<=) #-} + xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT + + {-# INLINE (>) #-} + xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT + + {-# INLINE (>=) #-} + xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT + +instance Storable a => Semigroup (Vector a) where + {-# INLINE (<>) #-} + (<>) = (++) + + {-# INLINE sconcat #-} + sconcat = G.concatNE + +instance Storable a => Monoid (Vector a) where + {-# INLINE mempty #-} + mempty = empty + + {-# INLINE mappend #-} + mappend = (++) + + {-# INLINE mconcat #-} + mconcat = concat + +#if __GLASGOW_HASKELL__ >= 708 + +instance Storable a => Exts.IsList (Vector a) where + type Item (Vector a) = a + fromList = fromList + fromListN = fromListN + toList = toList + +#endif + +-- Length +-- ------ + +-- | /O(1)/ Yield the length of the vector +length :: Storable a => Vector a -> Int +{-# INLINE length #-} +length = G.length + +-- | /O(1)/ Test whether a vector is empty +null :: Storable a => Vector a -> Bool +{-# INLINE null #-} +null = G.null + +-- Indexing +-- -------- + +-- | O(1) Indexing +(!) :: Storable a => Vector a -> Int -> a +{-# INLINE (!) #-} +(!) = (G.!) + +-- | O(1) Safe indexing +(!?) :: Storable a => Vector a -> Int -> Maybe a +{-# INLINE (!?) #-} +(!?) = (G.!?) + +-- | /O(1)/ First element +head :: Storable a => Vector a -> a +{-# INLINE head #-} +head = G.head + +-- | /O(1)/ Last element +last :: Storable a => Vector a -> a +{-# INLINE last #-} +last = G.last + +-- | /O(1)/ Unsafe indexing without bounds checking +unsafeIndex :: Storable a => Vector a -> Int -> a +{-# INLINE unsafeIndex #-} +unsafeIndex = G.unsafeIndex + +-- | /O(1)/ First element without checking if the vector is empty +unsafeHead :: Storable a => Vector a -> a +{-# INLINE unsafeHead #-} +unsafeHead = G.unsafeHead + +-- | /O(1)/ Last element without checking if the vector is empty +unsafeLast :: Storable a => Vector a -> a +{-# INLINE unsafeLast #-} +unsafeLast = G.unsafeLast + +-- Monadic indexing +-- ---------------- + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the vector when necessary. +-- Suppose vector copying is implemented like this: +-- +-- > copy mv v = ... write mv i (v ! i) ... +-- +-- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ +-- would unnecessarily retain a reference to @v@ in each element written. +-- +-- With 'indexM', copying can be implemented like this instead: +-- +-- > copy mv v = ... do +-- > x <- indexM v i +-- > write mv i x +-- +-- Here, no references to @v@ are retained because indexing (but /not/ the +-- elements) is evaluated eagerly. +-- +indexM :: (Storable a, Monad m) => Vector a -> Int -> m a +{-# INLINE indexM #-} +indexM = G.indexM + +-- | /O(1)/ First element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +headM :: (Storable a, Monad m) => Vector a -> m a +{-# INLINE headM #-} +headM = G.headM + +-- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +lastM :: (Storable a, Monad m) => Vector a -> m a +{-# INLINE lastM #-} +lastM = G.lastM + +-- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an +-- explanation of why this is useful. +unsafeIndexM :: (Storable a, Monad m) => Vector a -> Int -> m a +{-# INLINE unsafeIndexM #-} +unsafeIndexM = G.unsafeIndexM + +-- | /O(1)/ First element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeHeadM :: (Storable a, Monad m) => Vector a -> m a +{-# INLINE unsafeHeadM #-} +unsafeHeadM = G.unsafeHeadM + +-- | /O(1)/ Last element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeLastM :: (Storable a, Monad m) => Vector a -> m a +{-# INLINE unsafeLastM #-} +unsafeLastM = G.unsafeLastM + +-- Extracting subvectors (slicing) +-- ------------------------------- + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Storable a + => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE slice #-} +slice = G.slice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty. +init :: Storable a => Vector a -> Vector a +{-# INLINE init #-} +init = G.init + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty. +tail :: Storable a => Vector a -> Vector a +{-# INLINE tail #-} +tail = G.tail + +-- | /O(1)/ Yield at the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case it is returned unchanged. +take :: Storable a => Int -> Vector a -> Vector a +{-# INLINE take #-} +take = G.take + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case an empty vector is returned. +drop :: Storable a => Int -> Vector a -> Vector a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ +-- but slightly more efficient. +{-# INLINE splitAt #-} +splitAt :: Storable a => Int -> Vector a -> (Vector a, Vector a) +splitAt = G.splitAt + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must +-- contain at least @i+n@ elements but this is not checked. +unsafeSlice :: Storable a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty but this is not checked. +unsafeInit :: Storable a => Vector a -> Vector a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty but this is not checked. +unsafeTail :: Storable a => Vector a -> Vector a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector must +-- contain at least @n@ elements but this is not checked. +unsafeTake :: Storable a => Int -> Vector a -> Vector a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector +-- must contain at least @n@ elements but this is not checked. +unsafeDrop :: Storable a => Int -> Vector a -> Vector a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- Initialisation +-- -------------- + +-- | /O(1)/ Empty vector +empty :: Storable a => Vector a +{-# INLINE empty #-} +empty = G.empty + +-- | /O(1)/ Vector with exactly one element +singleton :: Storable a => a -> Vector a +{-# INLINE singleton #-} +singleton = G.singleton + +-- | /O(n)/ Vector of the given length with the same value in each position +replicate :: Storable a => Int -> a -> Vector a +{-# INLINE replicate #-} +replicate = G.replicate + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index +generate :: Storable a => Int -> (Int -> a) -> Vector a +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Apply function n times to value. Zeroth element is original value. +iterateN :: Storable a => Int -> (a -> a) -> a -> Vector a +{-# INLINE iterateN #-} +iterateN = G.iterateN + +-- Unfolding +-- --------- + +-- | /O(n)/ Construct a vector by repeatedly applying the generator function +-- to a seed. The generator function yields 'Just' the next element and the +-- new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 +-- > = <10,9,8,7,6,5,4,3,2,1> +unfoldr :: Storable a => (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldr #-} +unfoldr = G.unfoldr + +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> +unfoldrN :: Storable a => Int -> (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldrN #-} +unfoldrN = G.unfoldrN + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Storable a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Storable a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in f <a,b,c> +-- +constructN :: Storable a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in f <c,b,a> +-- +constructrN :: Storable a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN + +-- Enumeration +-- ----------- + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ +-- etc. This operation is usually more efficient than 'enumFromTo'. +-- +-- > enumFromN 5 3 = <5,6,7> +enumFromN :: (Storable a, Num a) => a -> Int -> Vector a +{-# INLINE enumFromN #-} +enumFromN = G.enumFromN + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, +-- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. +-- +-- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> +enumFromStepN :: (Storable a, Num a) => a -> a -> Int -> Vector a +{-# INLINE enumFromStepN #-} +enumFromStepN = G.enumFromStepN + +-- | /O(n)/ Enumerate values from @x@ to @y@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromN' instead. +enumFromTo :: (Storable a, Enum a) => a -> a -> Vector a +{-# INLINE enumFromTo #-} +enumFromTo = G.enumFromTo + +-- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Storable a, Enum a) => a -> a -> a -> Vector a +{-# INLINE enumFromThenTo #-} +enumFromThenTo = G.enumFromThenTo + +-- Concatenation +-- ------------- + +-- | /O(n)/ Prepend an element +cons :: Storable a => a -> Vector a -> Vector a +{-# INLINE cons #-} +cons = G.cons + +-- | /O(n)/ Append an element +snoc :: Storable a => Vector a -> a -> Vector a +{-# INLINE snoc #-} +snoc = G.snoc + +infixr 5 ++ +-- | /O(m+n)/ Concatenate two vectors +(++) :: Storable a => Vector a -> Vector a -> Vector a +{-# INLINE (++) #-} +(++) = (G.++) + +-- | /O(n)/ Concatenate all vectors in the list +concat :: Storable a => [Vector a] -> Vector a +{-# INLINE concat #-} +concat = G.concat + +-- Monadic initialisation +-- ---------------------- + +-- | /O(n)/ Execute the monadic action the given number of times and store the +-- results in a vector. +replicateM :: (Monad m, Storable a) => Int -> m a -> m (Vector a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +generateM :: (Monad m, Storable a) => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: (Monad m, Storable a) => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + +-- | Execute the monadic action and freeze the resulting vector. +-- +-- @ +-- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> +-- @ +create :: Storable a => (forall s. ST s (MVector s a)) -> Vector a +{-# INLINE create #-} +-- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 +create p = G.create p + +-- | Execute the monadic action and freeze the resulting vectors. +createT :: (Traversable f, Storable a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + +-- Restricting memory usage +-- ------------------------ + +-- | /O(n)/ Yield the argument but force it not to retain any extra memory, +-- possibly by copying it. +-- +-- This is especially useful when dealing with slices. For example: +-- +-- > force (slice 0 2 <huge vector>) +-- +-- Here, the slice retains a reference to the huge vector. Forcing it creates +-- a copy of just the elements that belong to the slice and allows the huge +-- vector to be garbage collected. +force :: Storable a => Vector a -> Vector a +{-# INLINE force #-} +force = G.force + +-- Bulk updates +-- ------------ + +-- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector +-- element at position @i@ by @a@. +-- +-- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> +-- +(//) :: Storable a => Vector a -- ^ initial vector (of length @m@) + -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE (//) #-} +(//) = (G.//) + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @a@ from the value vector, replace the element of the +-- initial vector at position @i@ by @a@. +-- +-- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> +-- +update_ :: Storable a + => Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector a -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE update_ #-} +update_ = G.update_ + +-- | Same as ('//') but without bounds checking. +unsafeUpd :: Storable a => Vector a -> [(Int, a)] -> Vector a +{-# INLINE unsafeUpd #-} +unsafeUpd = G.unsafeUpd + +-- | Same as 'update_' but without bounds checking. +unsafeUpdate_ :: Storable a => Vector a -> Vector Int -> Vector a -> Vector a +{-# INLINE unsafeUpdate_ #-} +unsafeUpdate_ = G.unsafeUpdate_ + +-- Accumulations +-- ------------- + +-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element +-- @a@ at position @i@ by @f a b@. +-- +-- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> +accum :: Storable a + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accum #-} +accum = G.accum + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the the value vector, +-- replace the element of the initial vector at +-- position @i@ by @f a b@. +-- +-- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> +-- +accumulate_ :: (Storable a, Storable b) + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector b -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE accumulate_ #-} +accumulate_ = G.accumulate_ + +-- | Same as 'accum' but without bounds checking. +unsafeAccum :: Storable a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a +{-# INLINE unsafeAccum #-} +unsafeAccum = G.unsafeAccum + +-- | Same as 'accumulate_' but without bounds checking. +unsafeAccumulate_ :: (Storable a, Storable b) => + (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a +{-# INLINE unsafeAccumulate_ #-} +unsafeAccumulate_ = G.unsafeAccumulate_ + +-- Permutations +-- ------------ + +-- | /O(n)/ Reverse a vector +reverse :: Storable a => Vector a -> Vector a +{-# INLINE reverse #-} +reverse = G.reverse + +-- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the +-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is +-- often much more efficient. +-- +-- > backpermute <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a> +backpermute :: Storable a => Vector a -> Vector Int -> Vector a +{-# INLINE backpermute #-} +backpermute = G.backpermute + +-- | Same as 'backpermute' but without bounds checking. +unsafeBackpermute :: Storable a => Vector a -> Vector Int -> Vector a +{-# INLINE unsafeBackpermute #-} +unsafeBackpermute = G.unsafeBackpermute + +-- Safe destructive updates +-- ------------------------ + +-- | Apply a destructive operation to a vector. The operation will be +-- performed in place if it is safe to do so and will modify a copy of the +-- vector otherwise. +-- +-- @ +-- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> +-- @ +modify :: Storable a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a +{-# INLINE modify #-} +modify p = G.modify p + +-- Mapping +-- ------- + +-- | /O(n)/ Map a function over a vector +map :: (Storable a, Storable b) => (a -> b) -> Vector a -> Vector b +{-# INLINE map #-} +map = G.map + +-- | /O(n)/ Apply a function to every element of a vector and its index +imap :: (Storable a, Storable b) => (Int -> a -> b) -> Vector a -> Vector b +{-# INLINE imap #-} +imap = G.imap + +-- | Map a function over a vector and concatenate the results. +concatMap :: (Storable a, Storable b) => (a -> Vector b) -> Vector a -> Vector b +{-# INLINE concatMap #-} +concatMap = G.concatMap + +-- Monadic mapping +-- --------------- + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results +mapM :: (Monad m, Storable a, Storable b) => (a -> m b) -> Vector a -> m (Vector b) +{-# INLINE mapM #-} +mapM = G.mapM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results +mapM_ :: (Monad m, Storable a) => (a -> m b) -> Vector a -> m () +{-# INLINE mapM_ #-} +mapM_ = G.mapM_ + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results. Equivalent to @flip 'mapM'@. +forM :: (Monad m, Storable a, Storable b) => Vector a -> (a -> m b) -> m (Vector b) +{-# INLINE forM #-} +forM = G.forM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results. Equivalent to @flip 'mapM_'@. +forM_ :: (Monad m, Storable a) => Vector a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- Zipping +-- ------- + +-- | /O(min(m,n))/ Zip two vectors with the given function. +zipWith :: (Storable a, Storable b, Storable c) + => (a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE zipWith #-} +zipWith = G.zipWith + +-- | Zip three vectors with the given function. +zipWith3 :: (Storable a, Storable b, Storable c, Storable d) + => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE zipWith3 #-} +zipWith3 = G.zipWith3 + +zipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) + => (a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE zipWith4 #-} +zipWith4 = G.zipWith4 + +zipWith5 :: (Storable a, Storable b, Storable c, Storable d, Storable e, + Storable f) + => (a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE zipWith5 #-} +zipWith5 = G.zipWith5 + +zipWith6 :: (Storable a, Storable b, Storable c, Storable d, Storable e, + Storable f, Storable g) + => (a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE zipWith6 #-} +zipWith6 = G.zipWith6 + +-- | /O(min(m,n))/ Zip two vectors with a function that also takes the +-- elements' indices. +izipWith :: (Storable a, Storable b, Storable c) + => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE izipWith #-} +izipWith = G.izipWith + +-- | Zip three vectors and their indices with the given function. +izipWith3 :: (Storable a, Storable b, Storable c, Storable d) + => (Int -> a -> b -> c -> d) + -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE izipWith3 #-} +izipWith3 = G.izipWith3 + +izipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) + => (Int -> a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE izipWith4 #-} +izipWith4 = G.izipWith4 + +izipWith5 :: (Storable a, Storable b, Storable c, Storable d, Storable e, + Storable f) + => (Int -> a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE izipWith5 #-} +izipWith5 = G.izipWith5 + +izipWith6 :: (Storable a, Storable b, Storable c, Storable d, Storable e, + Storable f, Storable g) + => (Int -> a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE izipWith6 #-} +izipWith6 = G.izipWith6 + +-- Monadic zipping +-- --------------- + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a +-- vector of results +zipWithM :: (Monad m, Storable a, Storable b, Storable c) + => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +{-# INLINE zipWithM #-} +zipWithM = G.zipWithM + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the +-- results +zipWithM_ :: (Monad m, Storable a, Storable b) + => (a -> b -> m c) -> Vector a -> Vector b -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ = G.zipWithM_ + +-- Filtering +-- --------- + +-- | /O(n)/ Drop elements that do not satisfy the predicate +filter :: Storable a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE filter #-} +filter = G.filter + +-- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to +-- values and their indices +ifilter :: Storable a => (Int -> a -> Bool) -> Vector a -> Vector a +{-# INLINE ifilter #-} +ifilter = G.ifilter + +-- | /O(n)/ Drop repeated adjacent elements. +uniq :: (Storable a, Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + +-- | /O(n)/ Drop elements when predicate returns Nothing +mapMaybe :: (Storable a, Storable b) => (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing +imapMaybe :: (Storable a, Storable b) => (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + +-- | /O(n)/ Drop elements that do not satisfy the monadic predicate +filterM :: (Monad m, Storable a) => (a -> m Bool) -> Vector a -> m (Vector a) +{-# INLINE filterM #-} +filterM = G.filterM + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate +-- without copying. +takeWhile :: Storable a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE takeWhile #-} +takeWhile = G.takeWhile + +-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate +-- without copying. +dropWhile :: Storable a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE dropWhile #-} +dropWhile = G.dropWhile + +-- Parititioning +-- ------------- + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. The +-- relative order of the elements is preserved at the cost of a sometimes +-- reduced performance compared to 'unstablePartition'. +partition :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE partition #-} +partition = G.partition + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. +-- The order of the elements is not preserved but the operation is often +-- faster than 'partition'. +unstablePartition :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE unstablePartition #-} +unstablePartition = G.unstablePartition + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +span :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE span #-} +span = G.span + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +break :: Storable a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE break #-} +break = G.break + +-- Searching +-- --------- + +infix 4 `elem` +-- | /O(n)/ Check if the vector contains an element +elem :: (Storable a, Eq a) => a -> Vector a -> Bool +{-# INLINE elem #-} +elem = G.elem + +infix 4 `notElem` +-- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') +notElem :: (Storable a, Eq a) => a -> Vector a -> Bool +{-# INLINE notElem #-} +notElem = G.notElem + +-- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' +-- if no such element exists. +find :: Storable a => (a -> Bool) -> Vector a -> Maybe a +{-# INLINE find #-} +find = G.find + +-- | /O(n)/ Yield 'Just' the index of the first element matching the predicate +-- or 'Nothing' if no such element exists. +findIndex :: Storable a => (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndex #-} +findIndex = G.findIndex + +-- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending +-- order. +findIndices :: Storable a => (a -> Bool) -> Vector a -> Vector Int +{-# INLINE findIndices #-} +findIndices = G.findIndices + +-- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or +-- 'Nothing' if the vector does not contain the element. This is a specialised +-- version of 'findIndex'. +elemIndex :: (Storable a, Eq a) => a -> Vector a -> Maybe Int +{-# INLINE elemIndex #-} +elemIndex = G.elemIndex + +-- | /O(n)/ Yield the indices of all occurences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +elemIndices :: (Storable a, Eq a) => a -> Vector a -> Vector Int +{-# INLINE elemIndices #-} +elemIndices = G.elemIndices + +-- Folding +-- ------- + +-- | /O(n)/ Left fold +foldl :: Storable b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Left fold on non-empty vectors +foldl1 :: Storable a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1 #-} +foldl1 = G.foldl1 + +-- | /O(n)/ Left fold with strict accumulator +foldl' :: Storable b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Left fold on non-empty vectors with strict accumulator +foldl1' :: Storable a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1' #-} +foldl1' = G.foldl1' + +-- | /O(n)/ Right fold +foldr :: Storable a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Right fold on non-empty vectors +foldr1 :: Storable a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1 #-} +foldr1 = G.foldr1 + +-- | /O(n)/ Right fold with a strict accumulator +foldr' :: Storable a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Right fold on non-empty vectors with strict accumulator +foldr1' :: Storable a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1' #-} +foldr1' = G.foldr1' + +-- | /O(n)/ Left fold (function applied to each element and its index) +ifoldl :: Storable b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Left fold with strict accumulator (function applied to each element +-- and its index) +ifoldl' :: Storable b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Right fold (function applied to each element and its index) +ifoldr :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Right fold with strict accumulator (function applied to each +-- element and its index) +ifoldr' :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- Specialised folds +-- ----------------- + +-- | /O(n)/ Check if all elements satisfy the predicate. +all :: Storable a => (a -> Bool) -> Vector a -> Bool +{-# INLINE all #-} +all = G.all + +-- | /O(n)/ Check if any element satisfies the predicate. +any :: Storable a => (a -> Bool) -> Vector a -> Bool +{-# INLINE any #-} +any = G.any + +-- | /O(n)/ Check if all elements are 'True' +and :: Vector Bool -> Bool +{-# INLINE and #-} +and = G.and + +-- | /O(n)/ Check if any element is 'True' +or :: Vector Bool -> Bool +{-# INLINE or #-} +or = G.or + +-- | /O(n)/ Compute the sum of the elements +sum :: (Storable a, Num a) => Vector a -> a +{-# INLINE sum #-} +sum = G.sum + +-- | /O(n)/ Compute the produce of the elements +product :: (Storable a, Num a) => Vector a -> a +{-# INLINE product #-} +product = G.product + +-- | /O(n)/ Yield the maximum element of the vector. The vector may not be +-- empty. +maximum :: (Storable a, Ord a) => Vector a -> a +{-# INLINE maximum #-} +maximum = G.maximum + +-- | /O(n)/ Yield the maximum element of the vector according to the given +-- comparison function. The vector may not be empty. +maximumBy :: Storable a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE maximumBy #-} +maximumBy = G.maximumBy + +-- | /O(n)/ Yield the minimum element of the vector. The vector may not be +-- empty. +minimum :: (Storable a, Ord a) => Vector a -> a +{-# INLINE minimum #-} +minimum = G.minimum + +-- | /O(n)/ Yield the minimum element of the vector according to the given +-- comparison function. The vector may not be empty. +minimumBy :: Storable a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE minimumBy #-} +minimumBy = G.minimumBy + +-- | /O(n)/ Yield the index of the maximum element of the vector. The vector +-- may not be empty. +maxIndex :: (Storable a, Ord a) => Vector a -> Int +{-# INLINE maxIndex #-} +maxIndex = G.maxIndex + +-- | /O(n)/ Yield the index of the maximum element of the vector according to +-- the given comparison function. The vector may not be empty. +maxIndexBy :: Storable a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE maxIndexBy #-} +maxIndexBy = G.maxIndexBy + +-- | /O(n)/ Yield the index of the minimum element of the vector. The vector +-- may not be empty. +minIndex :: (Storable a, Ord a) => Vector a -> Int +{-# INLINE minIndex #-} +minIndex = G.minIndex + +-- | /O(n)/ Yield the index of the minimum element of the vector according to +-- the given comparison function. The vector may not be empty. +minIndexBy :: Storable a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE minIndexBy #-} +minIndexBy = G.minIndexBy + +-- Monadic folds +-- ------------- + +-- | /O(n)/ Monadic fold +foldM :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold over non-empty vectors +fold1M :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M #-} +fold1M = G.fold1M + +-- | /O(n)/ Monadic fold with strict accumulator +foldM' :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +fold1M' :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M' #-} +fold1M' = G.fold1M' + +-- | /O(n)/ Monadic fold that discards the result +foldM_ :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold over non-empty vectors that discards the result +fold1M_ :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +foldM'_ :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +-- that discards the result +fold1M'_ :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + +-- Prefix sums (scans) +-- ------------------- + +-- | /O(n)/ Prescan +-- +-- @ +-- prescanl f z = 'init' . 'scanl' f z +-- @ +-- +-- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ +-- +prescanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl #-} +prescanl = G.prescanl + +-- | /O(n)/ Prescan with strict accumulator +prescanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl' #-} +prescanl' = G.prescanl' + +-- | /O(n)/ Scan +-- +-- @ +-- postscanl f z = 'tail' . 'scanl' f z +-- @ +-- +-- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ +-- +postscanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl #-} +postscanl = G.postscanl + +-- | /O(n)/ Scan with strict accumulator +postscanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl' #-} +postscanl' = G.postscanl' + +-- | /O(n)/ Haskell-style scan +-- +-- > scanl f z <x1,...,xn> = <y1,...,y(n+1)> +-- > where y1 = z +-- > yi = f y(i-1) x(i-1) +-- +-- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@ +-- +scanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl #-} +scanl = G.scanl + +-- | /O(n)/ Haskell-style scan with strict accumulator +scanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl' #-} +scanl' = G.scanl' + +-- | /O(n)/ Scan over a non-empty vector +-- +-- > scanl f <x1,...,xn> = <y1,...,yn> +-- > where y1 = x1 +-- > yi = f y(i-1) xi +-- +scanl1 :: Storable a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1 #-} +scanl1 = G.scanl1 + +-- | /O(n)/ Scan over a non-empty vector with a strict accumulator +scanl1' :: Storable a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1' #-} +scanl1' = G.scanl1' + +-- | /O(n)/ Right-to-left prescan +-- +-- @ +-- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' +-- @ +-- +prescanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr #-} +prescanr = G.prescanr + +-- | /O(n)/ Right-to-left prescan with strict accumulator +prescanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr' #-} +prescanr' = G.prescanr' + +-- | /O(n)/ Right-to-left scan +postscanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr #-} +postscanr = G.postscanr + +-- | /O(n)/ Right-to-left scan with strict accumulator +postscanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr' #-} +postscanr' = G.postscanr' + +-- | /O(n)/ Right-to-left Haskell-style scan +scanr :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr #-} +scanr = G.scanr + +-- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator +scanr' :: (Storable a, Storable b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr' #-} +scanr' = G.scanr' + +-- | /O(n)/ Right-to-left scan over a non-empty vector +scanr1 :: Storable a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1 #-} +scanr1 = G.scanr1 + +-- | /O(n)/ Right-to-left scan over a non-empty vector with a strict +-- accumulator +scanr1' :: Storable a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1' #-} +scanr1' = G.scanr1' + +-- Conversions - Lists +-- ------------------------ + +-- | /O(n)/ Convert a vector to a list +toList :: Storable a => Vector a -> [a] +{-# INLINE toList #-} +toList = G.toList + +-- | /O(n)/ Convert a list to a vector +fromList :: Storable a => [a] -> Vector a +{-# INLINE fromList #-} +fromList = G.fromList + +-- | /O(n)/ Convert the first @n@ elements of a list to a vector +-- +-- @ +-- fromListN n xs = 'fromList' ('take' n xs) +-- @ +fromListN :: Storable a => Int -> [a] -> Vector a +{-# INLINE fromListN #-} +fromListN = G.fromListN + +-- Conversions - Unsafe casts +-- -------------------------- + +-- | /O(1)/ Unsafely cast a vector from one element type to another. +-- The operation just changes the type of the underlying pointer and does not +-- modify the elements. +-- +-- The resulting vector contains as many elements as can fit into the +-- underlying memory block. +-- +unsafeCast :: forall a b. (Storable a, Storable b) => Vector a -> Vector b +{-# INLINE unsafeCast #-} +unsafeCast (Vector n fp) + = Vector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) + (castForeignPtr fp) + + +-- Conversions - Mutable vectors +-- ----------------------------- + +-- | /O(1)/ Unsafe convert a mutable vector to an immutable one without +-- copying. The mutable vector may not be used after this operation. +unsafeFreeze + :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE unsafeFreeze #-} +unsafeFreeze = G.unsafeFreeze + +-- | /O(1)/ Unsafely convert an immutable vector to a mutable one without +-- copying. The immutable vector may not be used after this operation. +unsafeThaw + :: (Storable a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE unsafeThaw #-} +unsafeThaw = G.unsafeThaw + +-- | /O(n)/ Yield a mutable copy of the immutable vector. +thaw :: (Storable a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE thaw #-} +thaw = G.thaw + +-- | /O(n)/ Yield an immutable copy of the mutable vector. +freeze :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE freeze #-} +freeze = G.freeze + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. This is not checked. +unsafeCopy + :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. +copy :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () +{-# INLINE copy #-} +copy = G.copy + +-- Conversions - Raw pointers +-- -------------------------- + +-- | /O(1)/ Create a vector from a 'ForeignPtr' with an offset and a length. +-- +-- The data may not be modified through the 'ForeignPtr' afterwards. +-- +-- If your offset is 0 it is more efficient to use 'unsafeFromForeignPtr0'. +unsafeFromForeignPtr :: Storable a + => ForeignPtr a -- ^ pointer + -> Int -- ^ offset + -> Int -- ^ length + -> Vector a +{-# INLINE_FUSED unsafeFromForeignPtr #-} +unsafeFromForeignPtr fp i n = unsafeFromForeignPtr0 fp' n + where + fp' = updPtr (`advancePtr` i) fp + +{-# RULES +"unsafeFromForeignPtr fp 0 n -> unsafeFromForeignPtr0 fp n " forall fp n. + unsafeFromForeignPtr fp 0 n = unsafeFromForeignPtr0 fp n #-} + + +-- | /O(1)/ Create a vector from a 'ForeignPtr' and a length. +-- +-- It is assumed the pointer points directly to the data (no offset). +-- Use `unsafeFromForeignPtr` if you need to specify an offset. +-- +-- The data may not be modified through the 'ForeignPtr' afterwards. +unsafeFromForeignPtr0 :: Storable a + => ForeignPtr a -- ^ pointer + -> Int -- ^ length + -> Vector a +{-# INLINE unsafeFromForeignPtr0 #-} +unsafeFromForeignPtr0 fp n = Vector n fp + +-- | /O(1)/ Yield the underlying 'ForeignPtr' together with the offset to the +-- data and its length. The data may not be modified through the 'ForeignPtr'. +unsafeToForeignPtr :: Storable a => Vector a -> (ForeignPtr a, Int, Int) +{-# INLINE unsafeToForeignPtr #-} +unsafeToForeignPtr (Vector n fp) = (fp, 0, n) + +-- | /O(1)/ Yield the underlying 'ForeignPtr' together with its length. +-- +-- You can assume the pointer points directly to the data (no offset). +-- +-- The data may not be modified through the 'ForeignPtr'. +unsafeToForeignPtr0 :: Storable a => Vector a -> (ForeignPtr a, Int) +{-# INLINE unsafeToForeignPtr0 #-} +unsafeToForeignPtr0 (Vector n fp) = (fp, n) + +-- | Pass a pointer to the vector's data to the IO action. The data may not be +-- modified through the 'Ptr. +unsafeWith :: Storable a => Vector a -> (Ptr a -> IO b) -> IO b +{-# INLINE unsafeWith #-} +unsafeWith (Vector _ fp) = withForeignPtr fp diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Internal.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Internal.hs new file mode 100644 index 0000000000..69a46d8421 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Internal.hs @@ -0,0 +1,33 @@ +-- | +-- Module : Data.Vector.Storable.Internal +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Ugly internal utility functions for implementing 'Storable'-based vectors. +-- + +module Data.Vector.Storable.Internal ( + getPtr, setPtr, updPtr +) where + +import Foreign.ForeignPtr +import Foreign.Ptr +import GHC.ForeignPtr ( ForeignPtr(..) ) +import GHC.Ptr ( Ptr(..) ) + +getPtr :: ForeignPtr a -> Ptr a +{-# INLINE getPtr #-} +getPtr (ForeignPtr addr _) = Ptr addr + +setPtr :: ForeignPtr a -> Ptr a -> ForeignPtr a +{-# INLINE setPtr #-} +setPtr (ForeignPtr _ c) (Ptr addr) = ForeignPtr addr c + +updPtr :: (Ptr a -> Ptr a) -> ForeignPtr a -> ForeignPtr a +{-# INLINE updPtr #-} +updPtr f (ForeignPtr p c) = case f (Ptr p) of { Ptr q -> ForeignPtr q c } + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Mutable.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Mutable.hs new file mode 100644 index 0000000000..29eb2fbfa3 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Storable/Mutable.hs @@ -0,0 +1,543 @@ +{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, MagicHash, MultiParamTypeClasses, ScopedTypeVariables #-} + +-- | +-- Module : Data.Vector.Storable.Mutable +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Mutable vectors based on Storable. +-- + +module Data.Vector.Storable.Mutable( + -- * Mutable vectors of 'Storable' types + MVector(..), IOVector, STVector, Storable, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, clone, + + -- ** Growing + grow, unsafeGrow, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, write, modify, swap, + unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, + + -- * Modifying vectors + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove, + + -- * Unsafe conversions + unsafeCast, + + -- * Raw pointers + unsafeFromForeignPtr, unsafeFromForeignPtr0, + unsafeToForeignPtr, unsafeToForeignPtr0, + unsafeWith +) where + +import Control.DeepSeq ( NFData(rnf) ) + +import qualified Data.Vector.Generic.Mutable as G +import Data.Vector.Storable.Internal + +import Foreign.Storable +import Foreign.ForeignPtr + +#if __GLASGOW_HASKELL__ >= 706 +import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes) +#elif __GLASGOW_HASKELL__ >= 700 +import Data.Primitive.ByteArray (MutableByteArray(..), newAlignedPinnedByteArray, + unsafeFreezeByteArray) +import GHC.Prim (byteArrayContents#, unsafeCoerce#) +import GHC.ForeignPtr +#endif + +import Foreign.Ptr +import Foreign.Marshal.Array ( advancePtr, copyArray, moveArray ) + +import Control.Monad.Primitive +import Data.Primitive.Addr +import Data.Primitive.Types (Prim) + +import GHC.Word (Word8, Word16, Word32, Word64) +import GHC.Ptr (Ptr(..)) + +import Prelude hiding ( length, null, replicate, reverse, map, read, + take, drop, splitAt, init, tail ) + +import Data.Typeable ( Typeable ) + +-- Data.Vector.Internal.Check is not needed +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- | Mutable 'Storable'-based vectors +data MVector s a = MVector {-# UNPACK #-} !Int + {-# UNPACK #-} !(ForeignPtr a) + deriving ( Typeable ) + +type IOVector = MVector RealWorld +type STVector s = MVector s + +instance NFData (MVector s a) where + rnf (MVector _ _) = () + +instance Storable a => G.MVector MVector a where + {-# INLINE basicLength #-} + basicLength (MVector n _) = n + + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice j m (MVector _ fp) = MVector m (updPtr (`advancePtr` j) fp) + + -- FIXME: this relies on non-portable pointer comparisons + {-# INLINE basicOverlaps #-} + basicOverlaps (MVector m fp) (MVector n fq) + = between p q (q `advancePtr` n) || between q p (p `advancePtr` m) + where + between x y z = x >= y && x < z + p = getPtr fp + q = getPtr fq + + {-# INLINE basicUnsafeNew #-} + basicUnsafeNew n + | n < 0 = error $ "Storable.basicUnsafeNew: negative length: " ++ show n + | n > mx = error $ "Storable.basicUnsafeNew: length too large: " ++ show n + | otherwise = unsafePrimToPrim $ do + fp <- mallocVector n + return $ MVector n fp + where + size = sizeOf (undefined :: a) + mx = maxBound `quot` size :: Int + + {-# INLINE basicInitialize #-} + basicInitialize = storableZero + + {-# INLINE basicUnsafeRead #-} + basicUnsafeRead (MVector _ fp) i + = unsafePrimToPrim + $ withForeignPtr fp (`peekElemOff` i) + + {-# INLINE basicUnsafeWrite #-} + basicUnsafeWrite (MVector _ fp) i x + = unsafePrimToPrim + $ withForeignPtr fp $ \p -> pokeElemOff p i x + + {-# INLINE basicSet #-} + basicSet = storableSet + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MVector n fp) (MVector _ fq) + = unsafePrimToPrim + $ withForeignPtr fp $ \p -> + withForeignPtr fq $ \q -> + copyArray p q n + + {-# INLINE basicUnsafeMove #-} + basicUnsafeMove (MVector n fp) (MVector _ fq) + = unsafePrimToPrim + $ withForeignPtr fp $ \p -> + withForeignPtr fq $ \q -> + moveArray p q n + +storableZero :: forall a m. (Storable a, PrimMonad m) => MVector (PrimState m) a -> m () +{-# INLINE storableZero #-} +storableZero (MVector n fp) = unsafePrimToPrim . withForeignPtr fp $ \(Ptr p) -> do + let q = Addr p + setAddr q byteSize (0 :: Word8) + where + x :: a + x = undefined + + byteSize :: Int + byteSize = n * sizeOf x + +storableSet :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> a -> m () +{-# INLINE storableSet #-} +storableSet (MVector n fp) x + | n == 0 = return () + | otherwise = unsafePrimToPrim $ + case sizeOf x of + 1 -> storableSetAsPrim n fp x (undefined :: Word8) + 2 -> storableSetAsPrim n fp x (undefined :: Word16) + 4 -> storableSetAsPrim n fp x (undefined :: Word32) + 8 -> storableSetAsPrim n fp x (undefined :: Word64) + _ -> withForeignPtr fp $ \p -> do + poke p x + + let do_set i + | 2*i < n = do + copyArray (p `advancePtr` i) p i + do_set (2*i) + | otherwise = copyArray (p `advancePtr` i) p (n-i) + + do_set 1 + +storableSetAsPrim + :: (Storable a, Prim b) => Int -> ForeignPtr a -> a -> b -> IO () +{-# INLINE [0] storableSetAsPrim #-} +storableSetAsPrim n fp x y = withForeignPtr fp $ \(Ptr p) -> do + poke (Ptr p) x + let q = Addr p + w <- readOffAddr q 0 + setAddr (q `plusAddr` sizeOf x) (n-1) (w `asTypeOf` y) + +{-# INLINE mallocVector #-} +mallocVector :: Storable a => Int -> IO (ForeignPtr a) +mallocVector = +#if __GLASGOW_HASKELL__ >= 706 + doMalloc undefined + where + doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b) + doMalloc dummy size = + mallocPlainForeignPtrAlignedBytes (size * sizeOf dummy) (alignment dummy) +#elif __GLASGOW_HASKELL__ >= 700 + doMalloc undefined + where + doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b) + doMalloc dummy size = do + arr@(MutableByteArray arr#) <- newAlignedPinnedByteArray arrSize arrAlign + newConcForeignPtr + (Ptr (byteArrayContents# (unsafeCoerce# arr#))) + -- Keep reference to mutable byte array until whole ForeignPtr goes out + -- of scope. + (touch arr) + where + arrSize = size * sizeOf dummy + arrAlign = alignment dummy +#else + mallocForeignPtrArray +#endif + +-- Length information +-- ------------------ + +-- | Length of the mutable vector. +length :: Storable a => MVector s a -> Int +{-# INLINE length #-} +length = G.length + +-- | Check whether the vector is empty +null :: Storable a => MVector s a -> Bool +{-# INLINE null #-} +null = G.null + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. +slice :: Storable a => Int -> Int -> MVector s a -> MVector s a +{-# INLINE slice #-} +slice = G.slice + +take :: Storable a => Int -> MVector s a -> MVector s a +{-# INLINE take #-} +take = G.take + +drop :: Storable a => Int -> MVector s a -> MVector s a +{-# INLINE drop #-} +drop = G.drop + +splitAt :: Storable a => Int -> MVector s a -> (MVector s a, MVector s a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +init :: Storable a => MVector s a -> MVector s a +{-# INLINE init #-} +init = G.init + +tail :: Storable a => MVector s a -> MVector s a +{-# INLINE tail #-} +tail = G.tail + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +unsafeSlice :: Storable a + => Int -- ^ starting index + -> Int -- ^ length of the slice + -> MVector s a + -> MVector s a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +unsafeTake :: Storable a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +unsafeDrop :: Storable a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +unsafeInit :: Storable a => MVector s a -> MVector s a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +unsafeTail :: Storable a => MVector s a -> MVector s a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +overlaps :: Storable a => MVector s a -> MVector s a -> Bool +{-# INLINE overlaps #-} +overlaps = G.overlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +new :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a) +{-# INLINE new #-} +new = G.new + +-- | Create a mutable vector of the given length. The memory is not initialized. +unsafeNew :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew = G.unsafeNew + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +replicate :: (PrimMonad m, Storable a) => Int -> a -> m (MVector (PrimState m) a) +{-# INLINE replicate #-} +replicate = G.replicate + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +replicateM :: (PrimMonad m, Storable a) => Int -> m a -> m (MVector (PrimState m) a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | Create a copy of a mutable vector. +clone :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -> m (MVector (PrimState m) a) +{-# INLINE clone #-} +clone = G.clone + +-- Growing +-- ------- + +-- | Grow a vector by the given number of elements. The number must be +-- positive. +grow :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE grow #-} +grow = G.grow + +-- | Grow a vector by the given number of elements. The number must be +-- positive but this is not checked. +unsafeGrow :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow = G.unsafeGrow + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- references to external objects. This is usually a noop for unboxed vectors. +clear :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> m () +{-# INLINE clear #-} +clear = G.clear + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. +read :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read = G.read + +-- | Replace the element at the given position. +write + :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE write #-} +write = G.write + +-- | Modify the element at the given position. +modify :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE modify #-} +modify = G.modify + +-- | Swap the elements at the given positions. +swap + :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap = G.swap + + +-- | Yield the element at the given position. No bounds checks are performed. +unsafeRead :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +unsafeRead = G.unsafeRead + +-- | Replace the element at the given position. No bounds checks are performed. +unsafeWrite + :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE unsafeWrite #-} +unsafeWrite = G.unsafeWrite + +-- | Modify the element at the given position. No bounds checks are performed. +unsafeModify :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE unsafeModify #-} +unsafeModify = G.unsafeModify + +-- | Swap the elements at the given positions. No bounds checks are performed. +unsafeSwap + :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE unsafeSwap #-} +unsafeSwap = G.unsafeSwap + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +set :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> a -> m () +{-# INLINE set #-} +set = G.set + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +copy :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE copy #-} +copy = G.copy + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. This is not checked. +unsafeCopy :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | Move the contents of a vector. The two vectors must have the same +-- length. +-- +-- If the vectors do not overlap, then this is equivalent to 'copy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +move :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -> MVector (PrimState m) a -> m () +{-# INLINE move #-} +move = G.move + +-- | Move the contents of a vector. The two vectors must have the same +-- length, but this is not checked. +-- +-- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +unsafeMove :: (PrimMonad m, Storable a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove = G.unsafeMove + +-- Unsafe conversions +-- ------------------ + +-- | /O(1)/ Unsafely cast a mutable vector from one element type to another. +-- The operation just changes the type of the underlying pointer and does not +-- modify the elements. +-- +-- The resulting vector contains as many elements as can fit into the +-- underlying memory block. +-- +unsafeCast :: forall a b s. + (Storable a, Storable b) => MVector s a -> MVector s b +{-# INLINE unsafeCast #-} +unsafeCast (MVector n fp) + = MVector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) + (castForeignPtr fp) + +-- Raw pointers +-- ------------ + +-- | Create a mutable vector from a 'ForeignPtr' with an offset and a length. +-- +-- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector +-- could have been frozen before the modification. +-- +-- If your offset is 0 it is more efficient to use 'unsafeFromForeignPtr0'. +unsafeFromForeignPtr :: Storable a + => ForeignPtr a -- ^ pointer + -> Int -- ^ offset + -> Int -- ^ length + -> MVector s a +{-# INLINE_FUSED unsafeFromForeignPtr #-} +unsafeFromForeignPtr fp i n = unsafeFromForeignPtr0 fp' n + where + fp' = updPtr (`advancePtr` i) fp + +{-# RULES +"unsafeFromForeignPtr fp 0 n -> unsafeFromForeignPtr0 fp n " forall fp n. + unsafeFromForeignPtr fp 0 n = unsafeFromForeignPtr0 fp n #-} + + +-- | /O(1)/ Create a mutable vector from a 'ForeignPtr' and a length. +-- +-- It is assumed the pointer points directly to the data (no offset). +-- Use `unsafeFromForeignPtr` if you need to specify an offset. +-- +-- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector +-- could have been frozen before the modification. +unsafeFromForeignPtr0 :: Storable a + => ForeignPtr a -- ^ pointer + -> Int -- ^ length + -> MVector s a +{-# INLINE unsafeFromForeignPtr0 #-} +unsafeFromForeignPtr0 fp n = MVector n fp + +-- | Yield the underlying 'ForeignPtr' together with the offset to the data +-- and its length. Modifying the data through the 'ForeignPtr' is +-- unsafe if the vector could have frozen before the modification. +unsafeToForeignPtr :: Storable a => MVector s a -> (ForeignPtr a, Int, Int) +{-# INLINE unsafeToForeignPtr #-} +unsafeToForeignPtr (MVector n fp) = (fp, 0, n) + +-- | /O(1)/ Yield the underlying 'ForeignPtr' together with its length. +-- +-- You can assume the pointer points directly to the data (no offset). +-- +-- Modifying the data through the 'ForeignPtr' is unsafe if the vector could +-- have frozen before the modification. +unsafeToForeignPtr0 :: Storable a => MVector s a -> (ForeignPtr a, Int) +{-# INLINE unsafeToForeignPtr0 #-} +unsafeToForeignPtr0 (MVector n fp) = (fp, n) + +-- | Pass a pointer to the vector's data to the IO action. Modifying data +-- through the pointer is unsafe if the vector could have been frozen before +-- the modification. +unsafeWith :: Storable a => IOVector a -> (Ptr a -> IO b) -> IO b +{-# INLINE unsafeWith #-} +unsafeWith (MVector _ fp) = withForeignPtr fp + diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed.hs new file mode 100644 index 0000000000..72dd109fb3 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed.hs @@ -0,0 +1,1488 @@ +{-# LANGUAGE CPP, Rank2Types, TypeFamilies #-} + +-- | +-- Module : Data.Vector.Unboxed +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Adaptive unboxed vectors. The implementation is based on type families +-- and picks an efficient, specialised representation for every element type. +-- In particular, unboxed vectors of pairs are represented as pairs of unboxed +-- vectors. +-- +-- Implementing unboxed vectors for new data types can be very easy. Here is +-- how the library does this for 'Complex' by simply wrapping vectors of +-- pairs. +-- +-- @ +-- newtype instance 'MVector' s ('Complex' a) = MV_Complex ('MVector' s (a,a)) +-- newtype instance 'Vector' ('Complex' a) = V_Complex ('Vector' (a,a)) +-- +-- instance ('RealFloat' a, 'Unbox' a) => 'Data.Vector.Generic.Mutable.MVector' 'MVector' ('Complex' a) where +-- {-\# INLINE basicLength \#-} +-- basicLength (MV_Complex v) = 'Data.Vector.Generic.Mutable.basicLength' v +-- ... +-- +-- instance ('RealFloat' a, 'Unbox' a) => Data.Vector.Generic.Vector 'Vector' ('Complex' a) where +-- {-\# INLINE basicLength \#-} +-- basicLength (V_Complex v) = Data.Vector.Generic.basicLength v +-- ... +-- +-- instance ('RealFloat' a, 'Unbox' a) => 'Unbox' ('Complex' a) +-- @ + +module Data.Vector.Unboxed ( + -- * Unboxed vectors + Vector, MVector(..), Unbox, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + unsafeIndex, unsafeHead, unsafeLast, + + -- ** Monadic indexing + indexM, headM, lastM, + unsafeIndexM, unsafeHeadM, unsafeLastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, iterateNM, create, createT, + + -- ** Unfolding + unfoldr, unfoldrN, + unfoldrM, unfoldrNM, + constructN, constructrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update, update_, + unsafeUpd, unsafeUpdate, unsafeUpdate_, + + -- ** Accumulations + accum, accumulate, accumulate_, + unsafeAccum, unsafeAccumulate, unsafeAccumulate_, + + -- ** Permutations + reverse, backpermute, unsafeBackpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Indexing + indexed, + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, imapM, mapM_, imapM_, forM, forM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + zip, zip3, zip4, zip5, zip6, + + -- ** Monadic zipping + zipWithM, izipWithM, zipWithM_, izipWithM_, + + -- ** Unzipping + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, uniq, + mapMaybe, imapMaybe, + filterM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, span, break, + + -- ** Searching + elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + + -- ** Specialised folds + all, any, and, or, + sum, product, + maximum, maximumBy, minimum, minimumBy, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, ifoldM, foldM', ifoldM', + fold1M, fold1M', foldM_, ifoldM_, + foldM'_, ifoldM'_, fold1M_, fold1M'_, + + -- * Prefix sums (scans) + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Other vector types + G.convert, + + -- ** Mutable vectors + freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy +) where + +import Data.Vector.Unboxed.Base +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Fusion.Bundle as Bundle +import Data.Vector.Fusion.Util ( delayed_min ) + +import Control.Monad.ST ( ST ) +import Control.Monad.Primitive + +import Prelude hiding ( length, null, + replicate, (++), concat, + head, last, + init, tail, take, drop, splitAt, reverse, + map, concatMap, + zipWith, zipWith3, zip, zip3, unzip, unzip3, + filter, takeWhile, dropWhile, span, break, + elem, notElem, + foldl, foldl1, foldr, foldr1, + all, any, and, or, sum, product, minimum, maximum, + scanl, scanl1, scanr, scanr1, + enumFromTo, enumFromThenTo, + mapM, mapM_ ) + +import Text.Read ( Read(..), readListPrecDefault ) +import Data.Semigroup ( Semigroup(..) ) + +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid ( Monoid(..) ) +import Data.Traversable ( Traversable ) +#endif + +#if __GLASGOW_HASKELL__ >= 708 +import qualified GHC.Exts as Exts (IsList(..)) +#endif + +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- See http://trac.haskell.org/vector/ticket/12 +instance (Unbox a, Eq a) => Eq (Vector a) where + {-# INLINE (==) #-} + xs == ys = Bundle.eq (G.stream xs) (G.stream ys) + + {-# INLINE (/=) #-} + xs /= ys = not (Bundle.eq (G.stream xs) (G.stream ys)) + +-- See http://trac.haskell.org/vector/ticket/12 +instance (Unbox a, Ord a) => Ord (Vector a) where + {-# INLINE compare #-} + compare xs ys = Bundle.cmp (G.stream xs) (G.stream ys) + + {-# INLINE (<) #-} + xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT + + {-# INLINE (<=) #-} + xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT + + {-# INLINE (>) #-} + xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT + + {-# INLINE (>=) #-} + xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT + +instance Unbox a => Semigroup (Vector a) where + {-# INLINE (<>) #-} + (<>) = (++) + + {-# INLINE sconcat #-} + sconcat = G.concatNE + +instance Unbox a => Monoid (Vector a) where + {-# INLINE mempty #-} + mempty = empty + + {-# INLINE mappend #-} + mappend = (++) + + {-# INLINE mconcat #-} + mconcat = concat + +instance (Show a, Unbox a) => Show (Vector a) where + showsPrec = G.showsPrec + +instance (Read a, Unbox a) => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + +#if __GLASGOW_HASKELL__ >= 708 + +instance (Unbox e) => Exts.IsList (Vector e) where + type Item (Vector e) = e + fromList = fromList + fromListN = fromListN + toList = toList + +#endif + +-- Length information +-- ------------------ + +-- | /O(1)/ Yield the length of the vector +length :: Unbox a => Vector a -> Int +{-# INLINE length #-} +length = G.length + +-- | /O(1)/ Test whether a vector is empty +null :: Unbox a => Vector a -> Bool +{-# INLINE null #-} +null = G.null + +-- Indexing +-- -------- + +-- | O(1) Indexing +(!) :: Unbox a => Vector a -> Int -> a +{-# INLINE (!) #-} +(!) = (G.!) + +-- | O(1) Safe indexing +(!?) :: Unbox a => Vector a -> Int -> Maybe a +{-# INLINE (!?) #-} +(!?) = (G.!?) + +-- | /O(1)/ First element +head :: Unbox a => Vector a -> a +{-# INLINE head #-} +head = G.head + +-- | /O(1)/ Last element +last :: Unbox a => Vector a -> a +{-# INLINE last #-} +last = G.last + +-- | /O(1)/ Unsafe indexing without bounds checking +unsafeIndex :: Unbox a => Vector a -> Int -> a +{-# INLINE unsafeIndex #-} +unsafeIndex = G.unsafeIndex + +-- | /O(1)/ First element without checking if the vector is empty +unsafeHead :: Unbox a => Vector a -> a +{-# INLINE unsafeHead #-} +unsafeHead = G.unsafeHead + +-- | /O(1)/ Last element without checking if the vector is empty +unsafeLast :: Unbox a => Vector a -> a +{-# INLINE unsafeLast #-} +unsafeLast = G.unsafeLast + +-- Monadic indexing +-- ---------------- + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the vector when necessary. +-- Suppose vector copying is implemented like this: +-- +-- > copy mv v = ... write mv i (v ! i) ... +-- +-- For lazy vectors, @v ! i@ would not be evaluated which means that @mv@ +-- would unnecessarily retain a reference to @v@ in each element written. +-- +-- With 'indexM', copying can be implemented like this instead: +-- +-- > copy mv v = ... do +-- > x <- indexM v i +-- > write mv i x +-- +-- Here, no references to @v@ are retained because indexing (but /not/ the +-- elements) is evaluated eagerly. +-- +indexM :: (Unbox a, Monad m) => Vector a -> Int -> m a +{-# INLINE indexM #-} +indexM = G.indexM + +-- | /O(1)/ First element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +headM :: (Unbox a, Monad m) => Vector a -> m a +{-# INLINE headM #-} +headM = G.headM + +-- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an +-- explanation of why this is useful. +lastM :: (Unbox a, Monad m) => Vector a -> m a +{-# INLINE lastM #-} +lastM = G.lastM + +-- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an +-- explanation of why this is useful. +unsafeIndexM :: (Unbox a, Monad m) => Vector a -> Int -> m a +{-# INLINE unsafeIndexM #-} +unsafeIndexM = G.unsafeIndexM + +-- | /O(1)/ First element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeHeadM :: (Unbox a, Monad m) => Vector a -> m a +{-# INLINE unsafeHeadM #-} +unsafeHeadM = G.unsafeHeadM + +-- | /O(1)/ Last element in a monad without checking for empty vectors. +-- See 'indexM' for an explanation of why this is useful. +unsafeLastM :: (Unbox a, Monad m) => Vector a -> m a +{-# INLINE unsafeLastM #-} +unsafeLastM = G.unsafeLastM + +-- Extracting subvectors (slicing) +-- ------------------------------- + +-- | /O(1)/ Yield a slice of the vector without copying it. The vector must +-- contain at least @i+n@ elements. +slice :: Unbox a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE slice #-} +slice = G.slice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty. +init :: Unbox a => Vector a -> Vector a +{-# INLINE init #-} +init = G.init + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty. +tail :: Unbox a => Vector a -> Vector a +{-# INLINE tail #-} +tail = G.tail + +-- | /O(1)/ Yield at the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case it is returned unchanged. +take :: Unbox a => Int -> Vector a -> Vector a +{-# INLINE take #-} +take = G.take + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may +-- contain less than @n@ elements in which case an empty vector is returned. +drop :: Unbox a => Int -> Vector a -> Vector a +{-# INLINE drop #-} +drop = G.drop + +-- | /O(1)/ Yield the first @n@ elements paired with the remainder without copying. +-- +-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ +-- but slightly more efficient. +{-# INLINE splitAt #-} +splitAt :: Unbox a => Int -> Vector a -> (Vector a, Vector a) +splitAt = G.splitAt + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must +-- contain at least @i+n@ elements but this is not checked. +unsafeSlice :: Unbox a => Int -- ^ @i@ starting index + -> Int -- ^ @n@ length + -> Vector a + -> Vector a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +-- | /O(1)/ Yield all but the last element without copying. The vector may not +-- be empty but this is not checked. +unsafeInit :: Unbox a => Vector a -> Vector a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +-- | /O(1)/ Yield all but the first element without copying. The vector may not +-- be empty but this is not checked. +unsafeTail :: Unbox a => Vector a -> Vector a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- | /O(1)/ Yield the first @n@ elements without copying. The vector must +-- contain at least @n@ elements but this is not checked. +unsafeTake :: Unbox a => Int -> Vector a -> Vector a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +-- | /O(1)/ Yield all but the first @n@ elements without copying. The vector +-- must contain at least @n@ elements but this is not checked. +unsafeDrop :: Unbox a => Int -> Vector a -> Vector a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +-- Initialisation +-- -------------- + +-- | /O(1)/ Empty vector +empty :: Unbox a => Vector a +{-# INLINE empty #-} +empty = G.empty + +-- | /O(1)/ Vector with exactly one element +singleton :: Unbox a => a -> Vector a +{-# INLINE singleton #-} +singleton = G.singleton + +-- | /O(n)/ Vector of the given length with the same value in each position +replicate :: Unbox a => Int -> a -> Vector a +{-# INLINE replicate #-} +replicate = G.replicate + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index +generate :: Unbox a => Int -> (Int -> a) -> Vector a +{-# INLINE generate #-} +generate = G.generate + +-- | /O(n)/ Apply function n times to value. Zeroth element is original value. +iterateN :: Unbox a => Int -> (a -> a) -> a -> Vector a +{-# INLINE iterateN #-} +iterateN = G.iterateN + +-- Unfolding +-- --------- + +-- | /O(n)/ Construct a vector by repeatedly applying the generator function +-- to a seed. The generator function yields 'Just' the next element and the +-- new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1)) 10 +-- > = <10,9,8,7,6,5,4,3,2,1> +unfoldr :: Unbox a => (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldr #-} +unfoldr = G.unfoldr + +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more elements. +-- +-- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> +unfoldrN :: Unbox a => Int -> (b -> Maybe (a, b)) -> b -> Vector a +{-# INLINE unfoldrN #-} +unfoldrN = G.unfoldrN + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Unbox a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Unbox a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f <a> ; c = f <a,b> in f <a,b,c> +-- +constructN :: Unbox a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f<a> ; c = f <b,a> in f <c,b,a> +-- +constructrN :: Unbox a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN + +-- Enumeration +-- ----------- + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+1@ +-- etc. This operation is usually more efficient than 'enumFromTo'. +-- +-- > enumFromN 5 3 = <5,6,7> +enumFromN :: (Unbox a, Num a) => a -> Int -> Vector a +{-# INLINE enumFromN #-} +enumFromN = G.enumFromN + +-- | /O(n)/ Yield a vector of the given length containing the values @x@, @x+y@, +-- @x+y+y@ etc. This operations is usually more efficient than 'enumFromThenTo'. +-- +-- > enumFromStepN 1 0.1 5 = <1,1.1,1.2,1.3,1.4> +enumFromStepN :: (Unbox a, Num a) => a -> a -> Int -> Vector a +{-# INLINE enumFromStepN #-} +enumFromStepN = G.enumFromStepN + +-- | /O(n)/ Enumerate values from @x@ to @y@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromN' instead. +enumFromTo :: (Unbox a, Enum a) => a -> a -> Vector a +{-# INLINE enumFromTo #-} +enumFromTo = G.enumFromTo + +-- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. +-- +-- /WARNING:/ This operation can be very inefficient. If at all possible, use +-- 'enumFromStepN' instead. +enumFromThenTo :: (Unbox a, Enum a) => a -> a -> a -> Vector a +{-# INLINE enumFromThenTo #-} +enumFromThenTo = G.enumFromThenTo + +-- Concatenation +-- ------------- + +-- | /O(n)/ Prepend an element +cons :: Unbox a => a -> Vector a -> Vector a +{-# INLINE cons #-} +cons = G.cons + +-- | /O(n)/ Append an element +snoc :: Unbox a => Vector a -> a -> Vector a +{-# INLINE snoc #-} +snoc = G.snoc + +infixr 5 ++ +-- | /O(m+n)/ Concatenate two vectors +(++) :: Unbox a => Vector a -> Vector a -> Vector a +{-# INLINE (++) #-} +(++) = (G.++) + +-- | /O(n)/ Concatenate all vectors in the list +concat :: Unbox a => [Vector a] -> Vector a +{-# INLINE concat #-} +concat = G.concat + +-- Monadic initialisation +-- ---------------------- + +-- | /O(n)/ Execute the monadic action the given number of times and store the +-- results in a vector. +replicateM :: (Monad m, Unbox a) => Int -> m a -> m (Vector a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +generateM :: (Monad m, Unbox a) => Int -> (Int -> m a) -> m (Vector a) +{-# INLINE generateM #-} +generateM = G.generateM + +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: (Monad m, Unbox a) => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + +-- | Execute the monadic action and freeze the resulting vector. +-- +-- @ +-- create (do { v \<- new 2; write v 0 \'a\'; write v 1 \'b\'; return v }) = \<'a','b'\> +-- @ +create :: Unbox a => (forall s. ST s (MVector s a)) -> Vector a +{-# INLINE create #-} +-- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 +create p = G.create p + +-- | Execute the monadic action and freeze the resulting vectors. +createT :: (Traversable f, Unbox a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + +-- Restricting memory usage +-- ------------------------ + +-- | /O(n)/ Yield the argument but force it not to retain any extra memory, +-- possibly by copying it. +-- +-- This is especially useful when dealing with slices. For example: +-- +-- > force (slice 0 2 <huge vector>) +-- +-- Here, the slice retains a reference to the huge vector. Forcing it creates +-- a copy of just the elements that belong to the slice and allows the huge +-- vector to be garbage collected. +force :: Unbox a => Vector a -> Vector a +{-# INLINE force #-} +force = G.force + +-- Bulk updates +-- ------------ + +-- | /O(m+n)/ For each pair @(i,a)@ from the list, replace the vector +-- element at position @i@ by @a@. +-- +-- > <5,9,2,7> // [(2,1),(0,3),(2,8)] = <3,9,8,7> +-- +(//) :: Unbox a => Vector a -- ^ initial vector (of length @m@) + -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE (//) #-} +(//) = (G.//) + +-- | /O(m+n)/ For each pair @(i,a)@ from the vector of index/value pairs, +-- replace the vector element at position @i@ by @a@. +-- +-- > update <5,9,2,7> <(2,1),(0,3),(2,8)> = <3,9,8,7> +-- +update :: Unbox a + => Vector a -- ^ initial vector (of length @m@) + -> Vector (Int, a) -- ^ vector of index/value pairs (of length @n@) + -> Vector a +{-# INLINE update #-} +update = G.update + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @a@ from the value vector, replace the element of the +-- initial vector at position @i@ by @a@. +-- +-- > update_ <5,9,2,7> <2,0,2> <1,3,8> = <3,9,8,7> +-- +-- The function 'update' provides the same functionality and is usually more +-- convenient. +-- +-- @ +-- update_ xs is ys = 'update' xs ('zip' is ys) +-- @ +update_ :: Unbox a + => Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector a -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE update_ #-} +update_ = G.update_ + +-- | Same as ('//') but without bounds checking. +unsafeUpd :: Unbox a => Vector a -> [(Int, a)] -> Vector a +{-# INLINE unsafeUpd #-} +unsafeUpd = G.unsafeUpd + +-- | Same as 'update' but without bounds checking. +unsafeUpdate :: Unbox a => Vector a -> Vector (Int, a) -> Vector a +{-# INLINE unsafeUpdate #-} +unsafeUpdate = G.unsafeUpdate + +-- | Same as 'update_' but without bounds checking. +unsafeUpdate_ :: Unbox a => Vector a -> Vector Int -> Vector a -> Vector a +{-# INLINE unsafeUpdate_ #-} +unsafeUpdate_ = G.unsafeUpdate_ + +-- Accumulations +-- ------------- + +-- | /O(m+n)/ For each pair @(i,b)@ from the list, replace the vector element +-- @a@ at position @i@ by @f a b@. +-- +-- > accum (+) <5,9,2> [(2,4),(1,6),(0,3),(1,7)] = <5+3, 9+6+7, 2+4> +accum :: Unbox a + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accum #-} +accum = G.accum + +-- | /O(m+n)/ For each pair @(i,b)@ from the vector of pairs, replace the vector +-- element @a@ at position @i@ by @f a b@. +-- +-- > accumulate (+) <5,9,2> <(2,4),(1,6),(0,3),(1,7)> = <5+3, 9+6+7, 2+4> +accumulate :: (Unbox a, Unbox b) + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector (Int,b) -- ^ vector of index/value pairs (of length @n@) + -> Vector a +{-# INLINE accumulate #-} +accumulate = G.accumulate + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the the value vector, +-- replace the element of the initial vector at +-- position @i@ by @f a b@. +-- +-- > accumulate_ (+) <5,9,2> <2,1,0,1> <4,6,3,7> = <5+3, 9+6+7, 2+4> +-- +-- The function 'accumulate' provides the same functionality and is usually more +-- convenient. +-- +-- @ +-- accumulate_ f as is bs = 'accumulate' f as ('zip' is bs) +-- @ +accumulate_ :: (Unbox a, Unbox b) + => (a -> b -> a) -- ^ accumulating function @f@ + -> Vector a -- ^ initial vector (of length @m@) + -> Vector Int -- ^ index vector (of length @n1@) + -> Vector b -- ^ value vector (of length @n2@) + -> Vector a +{-# INLINE accumulate_ #-} +accumulate_ = G.accumulate_ + +-- | Same as 'accum' but without bounds checking. +unsafeAccum :: Unbox a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a +{-# INLINE unsafeAccum #-} +unsafeAccum = G.unsafeAccum + +-- | Same as 'accumulate' but without bounds checking. +unsafeAccumulate :: (Unbox a, Unbox b) + => (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a +{-# INLINE unsafeAccumulate #-} +unsafeAccumulate = G.unsafeAccumulate + +-- | Same as 'accumulate_' but without bounds checking. +unsafeAccumulate_ :: (Unbox a, Unbox b) => + (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a +{-# INLINE unsafeAccumulate_ #-} +unsafeAccumulate_ = G.unsafeAccumulate_ + +-- Permutations +-- ------------ + +-- | /O(n)/ Reverse a vector +reverse :: Unbox a => Vector a -> Vector a +{-# INLINE reverse #-} +reverse = G.reverse + +-- | /O(n)/ Yield the vector obtained by replacing each element @i@ of the +-- index vector by @xs'!'i@. This is equivalent to @'map' (xs'!') is@ but is +-- often much more efficient. +-- +-- > backpermute <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a> +backpermute :: Unbox a => Vector a -> Vector Int -> Vector a +{-# INLINE backpermute #-} +backpermute = G.backpermute + +-- | Same as 'backpermute' but without bounds checking. +unsafeBackpermute :: Unbox a => Vector a -> Vector Int -> Vector a +{-# INLINE unsafeBackpermute #-} +unsafeBackpermute = G.unsafeBackpermute + +-- Safe destructive updates +-- ------------------------ + +-- | Apply a destructive operation to a vector. The operation will be +-- performed in place if it is safe to do so and will modify a copy of the +-- vector otherwise. +-- +-- @ +-- modify (\\v -> write v 0 \'x\') ('replicate' 3 \'a\') = \<\'x\',\'a\',\'a\'\> +-- @ +modify :: Unbox a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a +{-# INLINE modify #-} +modify p = G.modify p + +-- Indexing +-- -------- + +-- | /O(n)/ Pair each element in a vector with its index +indexed :: Unbox a => Vector a -> Vector (Int,a) +{-# INLINE indexed #-} +indexed = G.indexed + +-- Mapping +-- ------- + +-- | /O(n)/ Map a function over a vector +map :: (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b +{-# INLINE map #-} +map = G.map + +-- | /O(n)/ Apply a function to every element of a vector and its index +imap :: (Unbox a, Unbox b) => (Int -> a -> b) -> Vector a -> Vector b +{-# INLINE imap #-} +imap = G.imap + +-- | Map a function over a vector and concatenate the results. +concatMap :: (Unbox a, Unbox b) => (a -> Vector b) -> Vector a -> Vector b +{-# INLINE concatMap #-} +concatMap = G.concatMap + +-- Monadic mapping +-- --------------- + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results +mapM :: (Monad m, Unbox a, Unbox b) => (a -> m b) -> Vector a -> m (Vector b) +{-# INLINE mapM #-} +mapM = G.mapM + +-- | /O(n)/ Apply the monadic action to every element of a vector and its +-- index, yielding a vector of results +imapM :: (Monad m, Unbox a, Unbox b) + => (Int -> a -> m b) -> Vector a -> m (Vector b) +{-# INLINE imapM #-} +imapM = G.imapM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results +mapM_ :: (Monad m, Unbox a) => (a -> m b) -> Vector a -> m () +{-# INLINE mapM_ #-} +mapM_ = G.mapM_ + +-- | /O(n)/ Apply the monadic action to every element of a vector and its +-- index, ignoring the results +imapM_ :: (Monad m, Unbox a) => (Int -> a -> m b) -> Vector a -> m () +{-# INLINE imapM_ #-} +imapM_ = G.imapM_ + +-- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a +-- vector of results. Equivalent to @flip 'mapM'@. +forM :: (Monad m, Unbox a, Unbox b) => Vector a -> (a -> m b) -> m (Vector b) +{-# INLINE forM #-} +forM = G.forM + +-- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the +-- results. Equivalent to @flip 'mapM_'@. +forM_ :: (Monad m, Unbox a) => Vector a -> (a -> m b) -> m () +{-# INLINE forM_ #-} +forM_ = G.forM_ + +-- Zipping +-- ------- + +-- | /O(min(m,n))/ Zip two vectors with the given function. +zipWith :: (Unbox a, Unbox b, Unbox c) + => (a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE zipWith #-} +zipWith = G.zipWith + +-- | Zip three vectors with the given function. +zipWith3 :: (Unbox a, Unbox b, Unbox c, Unbox d) + => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE zipWith3 #-} +zipWith3 = G.zipWith3 + +zipWith4 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) + => (a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE zipWith4 #-} +zipWith4 = G.zipWith4 + +zipWith5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) + => (a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE zipWith5 #-} +zipWith5 = G.zipWith5 + +zipWith6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f, Unbox g) + => (a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE zipWith6 #-} +zipWith6 = G.zipWith6 + +-- | /O(min(m,n))/ Zip two vectors with a function that also takes the +-- elements' indices. +izipWith :: (Unbox a, Unbox b, Unbox c) + => (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c +{-# INLINE izipWith #-} +izipWith = G.izipWith + +-- | Zip three vectors and their indices with the given function. +izipWith3 :: (Unbox a, Unbox b, Unbox c, Unbox d) + => (Int -> a -> b -> c -> d) + -> Vector a -> Vector b -> Vector c -> Vector d +{-# INLINE izipWith3 #-} +izipWith3 = G.izipWith3 + +izipWith4 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) + => (Int -> a -> b -> c -> d -> e) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e +{-# INLINE izipWith4 #-} +izipWith4 = G.izipWith4 + +izipWith5 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) + => (Int -> a -> b -> c -> d -> e -> f) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f +{-# INLINE izipWith5 #-} +izipWith5 = G.izipWith5 + +izipWith6 :: (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f, Unbox g) + => (Int -> a -> b -> c -> d -> e -> f -> g) + -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e + -> Vector f -> Vector g +{-# INLINE izipWith6 #-} +izipWith6 = G.izipWith6 + +-- Monadic zipping +-- --------------- + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and yield a +-- vector of results +zipWithM :: (Monad m, Unbox a, Unbox b, Unbox c) + => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +{-# INLINE zipWithM #-} +zipWithM = G.zipWithM + +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes +-- the element index and yield a vector of results +izipWithM :: (Monad m, Unbox a, Unbox b, Unbox c) + => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m (Vector c) +{-# INLINE izipWithM #-} +izipWithM = G.izipWithM + +-- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the +-- results +zipWithM_ :: (Monad m, Unbox a, Unbox b) + => (a -> b -> m c) -> Vector a -> Vector b -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ = G.zipWithM_ + +-- | /O(min(m,n))/ Zip the two vectors with a monadic action that also takes +-- the element index and ignore the results +izipWithM_ :: (Monad m, Unbox a, Unbox b) + => (Int -> a -> b -> m c) -> Vector a -> Vector b -> m () +{-# INLINE izipWithM_ #-} +izipWithM_ = G.izipWithM_ + +-- Filtering +-- --------- + +-- | /O(n)/ Drop elements that do not satisfy the predicate +filter :: Unbox a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE filter #-} +filter = G.filter + +-- | /O(n)/ Drop repeated adjacent elements. +uniq :: (Unbox a, Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + +-- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to +-- values and their indices +ifilter :: Unbox a => (Int -> a -> Bool) -> Vector a -> Vector a +{-# INLINE ifilter #-} +ifilter = G.ifilter + +-- | /O(n)/ Drop elements when predicate returns Nothing +mapMaybe :: (Unbox a, Unbox b) => (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing +imapMaybe :: (Unbox a, Unbox b) => (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + +-- | /O(n)/ Drop elements that do not satisfy the monadic predicate +filterM :: (Monad m, Unbox a) => (a -> m Bool) -> Vector a -> m (Vector a) +{-# INLINE filterM #-} +filterM = G.filterM + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate +-- without copying. +takeWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE takeWhile #-} +takeWhile = G.takeWhile + +-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate +-- without copying. +dropWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a +{-# INLINE dropWhile #-} +dropWhile = G.dropWhile + +-- Parititioning +-- ------------- + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. The +-- relative order of the elements is preserved at the cost of a sometimes +-- reduced performance compared to 'unstablePartition'. +partition :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE partition #-} +partition = G.partition + +-- | /O(n)/ Split the vector in two parts, the first one containing those +-- elements that satisfy the predicate and the second one those that don't. +-- The order of the elements is not preserved but the operation is often +-- faster than 'partition'. +unstablePartition :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE unstablePartition #-} +unstablePartition = G.unstablePartition + +-- | /O(n)/ Split the vector into the longest prefix of elements that satisfy +-- the predicate and the rest without copying. +span :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE span #-} +span = G.span + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +break :: Unbox a => (a -> Bool) -> Vector a -> (Vector a, Vector a) +{-# INLINE break #-} +break = G.break + +-- Searching +-- --------- + +infix 4 `elem` +-- | /O(n)/ Check if the vector contains an element +elem :: (Unbox a, Eq a) => a -> Vector a -> Bool +{-# INLINE elem #-} +elem = G.elem + +infix 4 `notElem` +-- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') +notElem :: (Unbox a, Eq a) => a -> Vector a -> Bool +{-# INLINE notElem #-} +notElem = G.notElem + +-- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' +-- if no such element exists. +find :: Unbox a => (a -> Bool) -> Vector a -> Maybe a +{-# INLINE find #-} +find = G.find + +-- | /O(n)/ Yield 'Just' the index of the first element matching the predicate +-- or 'Nothing' if no such element exists. +findIndex :: Unbox a => (a -> Bool) -> Vector a -> Maybe Int +{-# INLINE findIndex #-} +findIndex = G.findIndex + +-- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending +-- order. +findIndices :: Unbox a => (a -> Bool) -> Vector a -> Vector Int +{-# INLINE findIndices #-} +findIndices = G.findIndices + +-- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or +-- 'Nothing' if the vector does not contain the element. This is a specialised +-- version of 'findIndex'. +elemIndex :: (Unbox a, Eq a) => a -> Vector a -> Maybe Int +{-# INLINE elemIndex #-} +elemIndex = G.elemIndex + +-- | /O(n)/ Yield the indices of all occurences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +elemIndices :: (Unbox a, Eq a) => a -> Vector a -> Vector Int +{-# INLINE elemIndices #-} +elemIndices = G.elemIndices + +-- Folding +-- ------- + +-- | /O(n)/ Left fold +foldl :: Unbox b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl #-} +foldl = G.foldl + +-- | /O(n)/ Left fold on non-empty vectors +foldl1 :: Unbox a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1 #-} +foldl1 = G.foldl1 + +-- | /O(n)/ Left fold with strict accumulator +foldl' :: Unbox b => (a -> b -> a) -> a -> Vector b -> a +{-# INLINE foldl' #-} +foldl' = G.foldl' + +-- | /O(n)/ Left fold on non-empty vectors with strict accumulator +foldl1' :: Unbox a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldl1' #-} +foldl1' = G.foldl1' + +-- | /O(n)/ Right fold +foldr :: Unbox a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr #-} +foldr = G.foldr + +-- | /O(n)/ Right fold on non-empty vectors +foldr1 :: Unbox a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1 #-} +foldr1 = G.foldr1 + +-- | /O(n)/ Right fold with a strict accumulator +foldr' :: Unbox a => (a -> b -> b) -> b -> Vector a -> b +{-# INLINE foldr' #-} +foldr' = G.foldr' + +-- | /O(n)/ Right fold on non-empty vectors with strict accumulator +foldr1' :: Unbox a => (a -> a -> a) -> Vector a -> a +{-# INLINE foldr1' #-} +foldr1' = G.foldr1' + +-- | /O(n)/ Left fold (function applied to each element and its index) +ifoldl :: Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl #-} +ifoldl = G.ifoldl + +-- | /O(n)/ Left fold with strict accumulator (function applied to each element +-- and its index) +ifoldl' :: Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a +{-# INLINE ifoldl' #-} +ifoldl' = G.ifoldl' + +-- | /O(n)/ Right fold (function applied to each element and its index) +ifoldr :: Unbox a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr #-} +ifoldr = G.ifoldr + +-- | /O(n)/ Right fold with strict accumulator (function applied to each +-- element and its index) +ifoldr' :: Unbox a => (Int -> a -> b -> b) -> b -> Vector a -> b +{-# INLINE ifoldr' #-} +ifoldr' = G.ifoldr' + +-- Specialised folds +-- ----------------- + +-- | /O(n)/ Check if all elements satisfy the predicate. +all :: Unbox a => (a -> Bool) -> Vector a -> Bool +{-# INLINE all #-} +all = G.all + +-- | /O(n)/ Check if any element satisfies the predicate. +any :: Unbox a => (a -> Bool) -> Vector a -> Bool +{-# INLINE any #-} +any = G.any + +-- | /O(n)/ Check if all elements are 'True' +and :: Vector Bool -> Bool +{-# INLINE and #-} +and = G.and + +-- | /O(n)/ Check if any element is 'True' +or :: Vector Bool -> Bool +{-# INLINE or #-} +or = G.or + +-- | /O(n)/ Compute the sum of the elements +sum :: (Unbox a, Num a) => Vector a -> a +{-# INLINE sum #-} +sum = G.sum + +-- | /O(n)/ Compute the produce of the elements +product :: (Unbox a, Num a) => Vector a -> a +{-# INLINE product #-} +product = G.product + +-- | /O(n)/ Yield the maximum element of the vector. The vector may not be +-- empty. +maximum :: (Unbox a, Ord a) => Vector a -> a +{-# INLINE maximum #-} +maximum = G.maximum + +-- | /O(n)/ Yield the maximum element of the vector according to the given +-- comparison function. The vector may not be empty. +maximumBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE maximumBy #-} +maximumBy = G.maximumBy + +-- | /O(n)/ Yield the minimum element of the vector. The vector may not be +-- empty. +minimum :: (Unbox a, Ord a) => Vector a -> a +{-# INLINE minimum #-} +minimum = G.minimum + +-- | /O(n)/ Yield the minimum element of the vector according to the given +-- comparison function. The vector may not be empty. +minimumBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> a +{-# INLINE minimumBy #-} +minimumBy = G.minimumBy + +-- | /O(n)/ Yield the index of the maximum element of the vector. The vector +-- may not be empty. +maxIndex :: (Unbox a, Ord a) => Vector a -> Int +{-# INLINE maxIndex #-} +maxIndex = G.maxIndex + +-- | /O(n)/ Yield the index of the maximum element of the vector according to +-- the given comparison function. The vector may not be empty. +maxIndexBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE maxIndexBy #-} +maxIndexBy = G.maxIndexBy + +-- | /O(n)/ Yield the index of the minimum element of the vector. The vector +-- may not be empty. +minIndex :: (Unbox a, Ord a) => Vector a -> Int +{-# INLINE minIndex #-} +minIndex = G.minIndex + +-- | /O(n)/ Yield the index of the minimum element of the vector according to +-- the given comparison function. The vector may not be empty. +minIndexBy :: Unbox a => (a -> a -> Ordering) -> Vector a -> Int +{-# INLINE minIndexBy #-} +minIndexBy = G.minIndexBy + +-- Monadic folds +-- ------------- + +-- | /O(n)/ Monadic fold +foldM :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM #-} +foldM = G.foldM + +-- | /O(n)/ Monadic fold (action applied to each element and its index) +ifoldM :: (Monad m, Unbox b) => (a -> Int -> b -> m a) -> a -> Vector b -> m a +{-# INLINE ifoldM #-} +ifoldM = G.ifoldM + +-- | /O(n)/ Monadic fold over non-empty vectors +fold1M :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M #-} +fold1M = G.fold1M + +-- | /O(n)/ Monadic fold with strict accumulator +foldM' :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m a +{-# INLINE foldM' #-} +foldM' = G.foldM' + +-- | /O(n)/ Monadic fold with strict accumulator (action applied to each +-- element and its index) +ifoldM' :: (Monad m, Unbox b) => (a -> Int -> b -> m a) -> a -> Vector b -> m a +{-# INLINE ifoldM' #-} +ifoldM' = G.ifoldM' + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +fold1M' :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m a +{-# INLINE fold1M' #-} +fold1M' = G.fold1M' + +-- | /O(n)/ Monadic fold that discards the result +foldM_ :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM_ #-} +foldM_ = G.foldM_ + +-- | /O(n)/ Monadic fold that discards the result (action applied to each +-- element and its index) +ifoldM_ :: (Monad m, Unbox b) => (a -> Int -> b -> m a) -> a -> Vector b -> m () +{-# INLINE ifoldM_ #-} +ifoldM_ = G.ifoldM_ + +-- | /O(n)/ Monadic fold over non-empty vectors that discards the result +fold1M_ :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M_ #-} +fold1M_ = G.fold1M_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +foldM'_ :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m () +{-# INLINE foldM'_ #-} +foldM'_ = G.foldM'_ + +-- | /O(n)/ Monadic fold with strict accumulator that discards the result +-- (action applied to each element and its index) +ifoldM'_ :: (Monad m, Unbox b) + => (a -> Int -> b -> m a) -> a -> Vector b -> m () +{-# INLINE ifoldM'_ #-} +ifoldM'_ = G.ifoldM'_ + +-- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator +-- that discards the result +fold1M'_ :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m () +{-# INLINE fold1M'_ #-} +fold1M'_ = G.fold1M'_ + +-- Prefix sums (scans) +-- ------------------- + +-- | /O(n)/ Prescan +-- +-- @ +-- prescanl f z = 'init' . 'scanl' f z +-- @ +-- +-- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ +-- +prescanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl #-} +prescanl = G.prescanl + +-- | /O(n)/ Prescan with strict accumulator +prescanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE prescanl' #-} +prescanl' = G.prescanl' + +-- | /O(n)/ Scan +-- +-- @ +-- postscanl f z = 'tail' . 'scanl' f z +-- @ +-- +-- Example: @postscanl (+) 0 \<1,2,3,4\> = \<1,3,6,10\>@ +-- +postscanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl #-} +postscanl = G.postscanl + +-- | /O(n)/ Scan with strict accumulator +postscanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE postscanl' #-} +postscanl' = G.postscanl' + +-- | /O(n)/ Haskell-style scan +-- +-- > scanl f z <x1,...,xn> = <y1,...,y(n+1)> +-- > where y1 = z +-- > yi = f y(i-1) x(i-1) +-- +-- Example: @scanl (+) 0 \<1,2,3,4\> = \<0,1,3,6,10\>@ +-- +scanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl #-} +scanl = G.scanl + +-- | /O(n)/ Haskell-style scan with strict accumulator +scanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE scanl' #-} +scanl' = G.scanl' + +-- | /O(n)/ Scan over a non-empty vector +-- +-- > scanl f <x1,...,xn> = <y1,...,yn> +-- > where y1 = x1 +-- > yi = f y(i-1) xi +-- +scanl1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1 #-} +scanl1 = G.scanl1 + +-- | /O(n)/ Scan over a non-empty vector with a strict accumulator +scanl1' :: Unbox a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanl1' #-} +scanl1' = G.scanl1' + +-- | /O(n)/ Right-to-left prescan +-- +-- @ +-- prescanr f z = 'reverse' . 'prescanl' (flip f) z . 'reverse' +-- @ +-- +prescanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr #-} +prescanr = G.prescanr + +-- | /O(n)/ Right-to-left prescan with strict accumulator +prescanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE prescanr' #-} +prescanr' = G.prescanr' + +-- | /O(n)/ Right-to-left scan +postscanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr #-} +postscanr = G.postscanr + +-- | /O(n)/ Right-to-left scan with strict accumulator +postscanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE postscanr' #-} +postscanr' = G.postscanr' + +-- | /O(n)/ Right-to-left Haskell-style scan +scanr :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr #-} +scanr = G.scanr + +-- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator +scanr' :: (Unbox a, Unbox b) => (a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE scanr' #-} +scanr' = G.scanr' + +-- | /O(n)/ Right-to-left scan over a non-empty vector +scanr1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1 #-} +scanr1 = G.scanr1 + +-- | /O(n)/ Right-to-left scan over a non-empty vector with a strict +-- accumulator +scanr1' :: Unbox a => (a -> a -> a) -> Vector a -> Vector a +{-# INLINE scanr1' #-} +scanr1' = G.scanr1' + +-- Conversions - Lists +-- ------------------------ + +-- | /O(n)/ Convert a vector to a list +toList :: Unbox a => Vector a -> [a] +{-# INLINE toList #-} +toList = G.toList + +-- | /O(n)/ Convert a list to a vector +fromList :: Unbox a => [a] -> Vector a +{-# INLINE fromList #-} +fromList = G.fromList + +-- | /O(n)/ Convert the first @n@ elements of a list to a vector +-- +-- @ +-- fromListN n xs = 'fromList' ('take' n xs) +-- @ +fromListN :: Unbox a => Int -> [a] -> Vector a +{-# INLINE fromListN #-} +fromListN = G.fromListN + +-- Conversions - Mutable vectors +-- ----------------------------- + +-- | /O(1)/ Unsafe convert a mutable vector to an immutable one without +-- copying. The mutable vector may not be used after this operation. +unsafeFreeze :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE unsafeFreeze #-} +unsafeFreeze = G.unsafeFreeze + +-- | /O(1)/ Unsafely convert an immutable vector to a mutable one without +-- copying. The immutable vector may not be used after this operation. +unsafeThaw :: (Unbox a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE unsafeThaw #-} +unsafeThaw = G.unsafeThaw + +-- | /O(n)/ Yield a mutable copy of the immutable vector. +thaw :: (Unbox a, PrimMonad m) => Vector a -> m (MVector (PrimState m) a) +{-# INLINE thaw #-} +thaw = G.thaw + +-- | /O(n)/ Yield an immutable copy of the mutable vector. +freeze :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> m (Vector a) +{-# INLINE freeze #-} +freeze = G.freeze + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. This is not checked. +unsafeCopy + :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | /O(n)/ Copy an immutable vector into a mutable one. The two vectors must +-- have the same length. +copy :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () +{-# INLINE copy #-} +copy = G.copy + + +#define DEFINE_IMMUTABLE +#include "unbox-tuple-instances" diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Base.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Base.hs new file mode 100644 index 0000000000..a88795c5b4 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Base.hs @@ -0,0 +1,408 @@ +{-# LANGUAGE BangPatterns, CPP, MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-} +#if __GLASGOW_HASKELL__ >= 707 +{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} +#endif +{-# OPTIONS_HADDOCK hide #-} + +-- | +-- Module : Data.Vector.Unboxed.Base +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Adaptive unboxed vectors: basic implementation +-- + +module Data.Vector.Unboxed.Base ( + MVector(..), IOVector, STVector, Vector(..), Unbox +) where + +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Generic.Mutable as M + +import qualified Data.Vector.Primitive as P + +import Control.DeepSeq ( NFData(rnf) ) + +import Control.Monad.Primitive +import Control.Monad ( liftM ) + +import Data.Word ( Word8, Word16, Word32, Word64 ) +import Data.Int ( Int8, Int16, Int32, Int64 ) +import Data.Complex + +#if !MIN_VERSION_base(4,8,0) +import Data.Word ( Word ) +#endif + +#if __GLASGOW_HASKELL__ >= 707 +import Data.Typeable ( Typeable ) +#else +import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp, + mkTyCon3 + ) +#endif + +import Data.Data ( Data(..) ) + +-- Data.Vector.Internal.Check is unused +#define NOT_VECTOR_MODULE +#include "vector.h" + +data family MVector s a +data family Vector a + +type IOVector = MVector RealWorld +type STVector s = MVector s + +type instance G.Mutable Vector = MVector + +class (G.Vector Vector a, M.MVector MVector a) => Unbox a + +instance NFData (Vector a) where rnf !_ = () +instance NFData (MVector s a) where rnf !_ = () + +-- ----------------- +-- Data and Typeable +-- ----------------- +#if __GLASGOW_HASKELL__ >= 707 +deriving instance Typeable Vector +deriving instance Typeable MVector +#else +vectorTyCon = mkTyCon3 "vector" + +instance Typeable1 Vector where + typeOf1 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") [] + +instance Typeable2 MVector where + typeOf2 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") [] +#endif + +instance (Data a, Unbox a) => Data (Vector a) where + gfoldl = G.gfoldl + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = G.mkType "Data.Vector.Unboxed.Vector" + dataCast1 = G.dataCast + +-- ---- +-- Unit +-- ---- + +newtype instance MVector s () = MV_Unit Int +newtype instance Vector () = V_Unit Int + +instance Unbox () + +instance M.MVector MVector () where + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicClear #-} + {-# INLINE basicSet #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeGrow #-} + + basicLength (MV_Unit n) = n + + basicUnsafeSlice _ m (MV_Unit _) = MV_Unit m + + basicOverlaps _ _ = False + + basicUnsafeNew n = return (MV_Unit n) + + -- Nothing to initialize + basicInitialize _ = return () + + basicUnsafeRead (MV_Unit _) _ = return () + + basicUnsafeWrite (MV_Unit _) _ () = return () + + basicClear _ = return () + + basicSet (MV_Unit _) () = return () + + basicUnsafeCopy (MV_Unit _) (MV_Unit _) = return () + + basicUnsafeGrow (MV_Unit n) m = return $ MV_Unit (n+m) + +instance G.Vector Vector () where + {-# INLINE basicUnsafeFreeze #-} + basicUnsafeFreeze (MV_Unit n) = return $ V_Unit n + + {-# INLINE basicUnsafeThaw #-} + basicUnsafeThaw (V_Unit n) = return $ MV_Unit n + + {-# INLINE basicLength #-} + basicLength (V_Unit n) = n + + {-# INLINE basicUnsafeSlice #-} + basicUnsafeSlice _ m (V_Unit _) = V_Unit m + + {-# INLINE basicUnsafeIndexM #-} + basicUnsafeIndexM (V_Unit _) _ = return () + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MV_Unit _) (V_Unit _) = return () + + {-# INLINE elemseq #-} + elemseq _ = seq + + +-- --------------- +-- Primitive types +-- --------------- + +#define primMVector(ty,con) \ +instance M.MVector MVector ty where { \ + {-# INLINE basicLength #-} \ +; {-# INLINE basicUnsafeSlice #-} \ +; {-# INLINE basicOverlaps #-} \ +; {-# INLINE basicUnsafeNew #-} \ +; {-# INLINE basicInitialize #-} \ +; {-# INLINE basicUnsafeReplicate #-} \ +; {-# INLINE basicUnsafeRead #-} \ +; {-# INLINE basicUnsafeWrite #-} \ +; {-# INLINE basicClear #-} \ +; {-# INLINE basicSet #-} \ +; {-# INLINE basicUnsafeCopy #-} \ +; {-# INLINE basicUnsafeGrow #-} \ +; basicLength (con v) = M.basicLength v \ +; basicUnsafeSlice i n (con v) = con $ M.basicUnsafeSlice i n v \ +; basicOverlaps (con v1) (con v2) = M.basicOverlaps v1 v2 \ +; basicUnsafeNew n = con `liftM` M.basicUnsafeNew n \ +; basicInitialize (con v) = M.basicInitialize v \ +; basicUnsafeReplicate n x = con `liftM` M.basicUnsafeReplicate n x \ +; basicUnsafeRead (con v) i = M.basicUnsafeRead v i \ +; basicUnsafeWrite (con v) i x = M.basicUnsafeWrite v i x \ +; basicClear (con v) = M.basicClear v \ +; basicSet (con v) x = M.basicSet v x \ +; basicUnsafeCopy (con v1) (con v2) = M.basicUnsafeCopy v1 v2 \ +; basicUnsafeMove (con v1) (con v2) = M.basicUnsafeMove v1 v2 \ +; basicUnsafeGrow (con v) n = con `liftM` M.basicUnsafeGrow v n } + +#define primVector(ty,con,mcon) \ +instance G.Vector Vector ty where { \ + {-# INLINE basicUnsafeFreeze #-} \ +; {-# INLINE basicUnsafeThaw #-} \ +; {-# INLINE basicLength #-} \ +; {-# INLINE basicUnsafeSlice #-} \ +; {-# INLINE basicUnsafeIndexM #-} \ +; {-# INLINE elemseq #-} \ +; basicUnsafeFreeze (mcon v) = con `liftM` G.basicUnsafeFreeze v \ +; basicUnsafeThaw (con v) = mcon `liftM` G.basicUnsafeThaw v \ +; basicLength (con v) = G.basicLength v \ +; basicUnsafeSlice i n (con v) = con $ G.basicUnsafeSlice i n v \ +; basicUnsafeIndexM (con v) i = G.basicUnsafeIndexM v i \ +; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v \ +; elemseq _ = seq } + +newtype instance MVector s Int = MV_Int (P.MVector s Int) +newtype instance Vector Int = V_Int (P.Vector Int) +instance Unbox Int +primMVector(Int, MV_Int) +primVector(Int, V_Int, MV_Int) + +newtype instance MVector s Int8 = MV_Int8 (P.MVector s Int8) +newtype instance Vector Int8 = V_Int8 (P.Vector Int8) +instance Unbox Int8 +primMVector(Int8, MV_Int8) +primVector(Int8, V_Int8, MV_Int8) + +newtype instance MVector s Int16 = MV_Int16 (P.MVector s Int16) +newtype instance Vector Int16 = V_Int16 (P.Vector Int16) +instance Unbox Int16 +primMVector(Int16, MV_Int16) +primVector(Int16, V_Int16, MV_Int16) + +newtype instance MVector s Int32 = MV_Int32 (P.MVector s Int32) +newtype instance Vector Int32 = V_Int32 (P.Vector Int32) +instance Unbox Int32 +primMVector(Int32, MV_Int32) +primVector(Int32, V_Int32, MV_Int32) + +newtype instance MVector s Int64 = MV_Int64 (P.MVector s Int64) +newtype instance Vector Int64 = V_Int64 (P.Vector Int64) +instance Unbox Int64 +primMVector(Int64, MV_Int64) +primVector(Int64, V_Int64, MV_Int64) + + +newtype instance MVector s Word = MV_Word (P.MVector s Word) +newtype instance Vector Word = V_Word (P.Vector Word) +instance Unbox Word +primMVector(Word, MV_Word) +primVector(Word, V_Word, MV_Word) + +newtype instance MVector s Word8 = MV_Word8 (P.MVector s Word8) +newtype instance Vector Word8 = V_Word8 (P.Vector Word8) +instance Unbox Word8 +primMVector(Word8, MV_Word8) +primVector(Word8, V_Word8, MV_Word8) + +newtype instance MVector s Word16 = MV_Word16 (P.MVector s Word16) +newtype instance Vector Word16 = V_Word16 (P.Vector Word16) +instance Unbox Word16 +primMVector(Word16, MV_Word16) +primVector(Word16, V_Word16, MV_Word16) + +newtype instance MVector s Word32 = MV_Word32 (P.MVector s Word32) +newtype instance Vector Word32 = V_Word32 (P.Vector Word32) +instance Unbox Word32 +primMVector(Word32, MV_Word32) +primVector(Word32, V_Word32, MV_Word32) + +newtype instance MVector s Word64 = MV_Word64 (P.MVector s Word64) +newtype instance Vector Word64 = V_Word64 (P.Vector Word64) +instance Unbox Word64 +primMVector(Word64, MV_Word64) +primVector(Word64, V_Word64, MV_Word64) + + +newtype instance MVector s Float = MV_Float (P.MVector s Float) +newtype instance Vector Float = V_Float (P.Vector Float) +instance Unbox Float +primMVector(Float, MV_Float) +primVector(Float, V_Float, MV_Float) + +newtype instance MVector s Double = MV_Double (P.MVector s Double) +newtype instance Vector Double = V_Double (P.Vector Double) +instance Unbox Double +primMVector(Double, MV_Double) +primVector(Double, V_Double, MV_Double) + + +newtype instance MVector s Char = MV_Char (P.MVector s Char) +newtype instance Vector Char = V_Char (P.Vector Char) +instance Unbox Char +primMVector(Char, MV_Char) +primVector(Char, V_Char, MV_Char) + +-- ---- +-- Bool +-- ---- + +fromBool :: Bool -> Word8 +{-# INLINE fromBool #-} +fromBool True = 1 +fromBool False = 0 + +toBool :: Word8 -> Bool +{-# INLINE toBool #-} +toBool 0 = False +toBool _ = True + +newtype instance MVector s Bool = MV_Bool (P.MVector s Word8) +newtype instance Vector Bool = V_Bool (P.Vector Word8) + +instance Unbox Bool + +instance M.MVector MVector Bool where + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicUnsafeReplicate #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicClear #-} + {-# INLINE basicSet #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeGrow #-} + basicLength (MV_Bool v) = M.basicLength v + basicUnsafeSlice i n (MV_Bool v) = MV_Bool $ M.basicUnsafeSlice i n v + basicOverlaps (MV_Bool v1) (MV_Bool v2) = M.basicOverlaps v1 v2 + basicUnsafeNew n = MV_Bool `liftM` M.basicUnsafeNew n + basicInitialize (MV_Bool v) = M.basicInitialize v + basicUnsafeReplicate n x = MV_Bool `liftM` M.basicUnsafeReplicate n (fromBool x) + basicUnsafeRead (MV_Bool v) i = toBool `liftM` M.basicUnsafeRead v i + basicUnsafeWrite (MV_Bool v) i x = M.basicUnsafeWrite v i (fromBool x) + basicClear (MV_Bool v) = M.basicClear v + basicSet (MV_Bool v) x = M.basicSet v (fromBool x) + basicUnsafeCopy (MV_Bool v1) (MV_Bool v2) = M.basicUnsafeCopy v1 v2 + basicUnsafeMove (MV_Bool v1) (MV_Bool v2) = M.basicUnsafeMove v1 v2 + basicUnsafeGrow (MV_Bool v) n = MV_Bool `liftM` M.basicUnsafeGrow v n + +instance G.Vector Vector Bool where + {-# INLINE basicUnsafeFreeze #-} + {-# INLINE basicUnsafeThaw #-} + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicUnsafeIndexM #-} + {-# INLINE elemseq #-} + basicUnsafeFreeze (MV_Bool v) = V_Bool `liftM` G.basicUnsafeFreeze v + basicUnsafeThaw (V_Bool v) = MV_Bool `liftM` G.basicUnsafeThaw v + basicLength (V_Bool v) = G.basicLength v + basicUnsafeSlice i n (V_Bool v) = V_Bool $ G.basicUnsafeSlice i n v + basicUnsafeIndexM (V_Bool v) i = toBool `liftM` G.basicUnsafeIndexM v i + basicUnsafeCopy (MV_Bool mv) (V_Bool v) = G.basicUnsafeCopy mv v + elemseq _ = seq + +-- ------- +-- Complex +-- ------- + +newtype instance MVector s (Complex a) = MV_Complex (MVector s (a,a)) +newtype instance Vector (Complex a) = V_Complex (Vector (a,a)) + +instance (Unbox a) => Unbox (Complex a) + +instance (Unbox a) => M.MVector MVector (Complex a) where + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicOverlaps #-} + {-# INLINE basicUnsafeNew #-} + {-# INLINE basicInitialize #-} + {-# INLINE basicUnsafeReplicate #-} + {-# INLINE basicUnsafeRead #-} + {-# INLINE basicUnsafeWrite #-} + {-# INLINE basicClear #-} + {-# INLINE basicSet #-} + {-# INLINE basicUnsafeCopy #-} + {-# INLINE basicUnsafeGrow #-} + basicLength (MV_Complex v) = M.basicLength v + basicUnsafeSlice i n (MV_Complex v) = MV_Complex $ M.basicUnsafeSlice i n v + basicOverlaps (MV_Complex v1) (MV_Complex v2) = M.basicOverlaps v1 v2 + basicUnsafeNew n = MV_Complex `liftM` M.basicUnsafeNew n + basicInitialize (MV_Complex v) = M.basicInitialize v + basicUnsafeReplicate n (x :+ y) = MV_Complex `liftM` M.basicUnsafeReplicate n (x,y) + basicUnsafeRead (MV_Complex v) i = uncurry (:+) `liftM` M.basicUnsafeRead v i + basicUnsafeWrite (MV_Complex v) i (x :+ y) = M.basicUnsafeWrite v i (x,y) + basicClear (MV_Complex v) = M.basicClear v + basicSet (MV_Complex v) (x :+ y) = M.basicSet v (x,y) + basicUnsafeCopy (MV_Complex v1) (MV_Complex v2) = M.basicUnsafeCopy v1 v2 + basicUnsafeMove (MV_Complex v1) (MV_Complex v2) = M.basicUnsafeMove v1 v2 + basicUnsafeGrow (MV_Complex v) n = MV_Complex `liftM` M.basicUnsafeGrow v n + +instance (Unbox a) => G.Vector Vector (Complex a) where + {-# INLINE basicUnsafeFreeze #-} + {-# INLINE basicUnsafeThaw #-} + {-# INLINE basicLength #-} + {-# INLINE basicUnsafeSlice #-} + {-# INLINE basicUnsafeIndexM #-} + {-# INLINE elemseq #-} + basicUnsafeFreeze (MV_Complex v) = V_Complex `liftM` G.basicUnsafeFreeze v + basicUnsafeThaw (V_Complex v) = MV_Complex `liftM` G.basicUnsafeThaw v + basicLength (V_Complex v) = G.basicLength v + basicUnsafeSlice i n (V_Complex v) = V_Complex $ G.basicUnsafeSlice i n v + basicUnsafeIndexM (V_Complex v) i + = uncurry (:+) `liftM` G.basicUnsafeIndexM v i + basicUnsafeCopy (MV_Complex mv) (V_Complex v) + = G.basicUnsafeCopy mv v + elemseq _ (x :+ y) z = G.elemseq (undefined :: Vector a) x + $ G.elemseq (undefined :: Vector a) y z + +-- ------ +-- Tuples +-- ------ + +#define DEFINE_INSTANCES +#include "unbox-tuple-instances" diff --git a/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Mutable.hs b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Mutable.hs new file mode 100644 index 0000000000..cb82acea8f --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Unboxed/Mutable.hs @@ -0,0 +1,307 @@ +{-# LANGUAGE CPP #-} + +-- | +-- Module : Data.Vector.Unboxed.Mutable +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> +-- Stability : experimental +-- Portability : non-portable +-- +-- Mutable adaptive unboxed vectors +-- + +module Data.Vector.Unboxed.Mutable ( + -- * Mutable vectors of primitive types + MVector(..), IOVector, STVector, Unbox, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, unsafeNew, replicate, replicateM, clone, + + -- ** Growing + grow, unsafeGrow, + + -- ** Restricting memory usage + clear, + + -- * Zipping and unzipping + zip, zip3, zip4, zip5, zip6, + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Accessing individual elements + read, write, modify, swap, + unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, + + -- * Modifying vectors + nextPermutation, + + -- ** Filling and copying + set, copy, move, unsafeCopy, unsafeMove +) where + +import Data.Vector.Unboxed.Base +import qualified Data.Vector.Generic.Mutable as G +import Data.Vector.Fusion.Util ( delayed_min ) +import Control.Monad.Primitive + +import Prelude hiding ( length, null, replicate, reverse, map, read, + take, drop, splitAt, init, tail, + zip, zip3, unzip, unzip3 ) + +-- don't import an unused Data.Vector.Internal.Check +#define NOT_VECTOR_MODULE +#include "vector.h" + +-- Length information +-- ------------------ + +-- | Length of the mutable vector. +length :: Unbox a => MVector s a -> Int +{-# INLINE length #-} +length = G.length + +-- | Check whether the vector is empty +null :: Unbox a => MVector s a -> Bool +{-# INLINE null #-} +null = G.null + +-- Extracting subvectors +-- --------------------- + +-- | Yield a part of the mutable vector without copying it. +slice :: Unbox a => Int -> Int -> MVector s a -> MVector s a +{-# INLINE slice #-} +slice = G.slice + +take :: Unbox a => Int -> MVector s a -> MVector s a +{-# INLINE take #-} +take = G.take + +drop :: Unbox a => Int -> MVector s a -> MVector s a +{-# INLINE drop #-} +drop = G.drop + +splitAt :: Unbox a => Int -> MVector s a -> (MVector s a, MVector s a) +{-# INLINE splitAt #-} +splitAt = G.splitAt + +init :: Unbox a => MVector s a -> MVector s a +{-# INLINE init #-} +init = G.init + +tail :: Unbox a => MVector s a -> MVector s a +{-# INLINE tail #-} +tail = G.tail + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +unsafeSlice :: Unbox a + => Int -- ^ starting index + -> Int -- ^ length of the slice + -> MVector s a + -> MVector s a +{-# INLINE unsafeSlice #-} +unsafeSlice = G.unsafeSlice + +unsafeTake :: Unbox a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeTake #-} +unsafeTake = G.unsafeTake + +unsafeDrop :: Unbox a => Int -> MVector s a -> MVector s a +{-# INLINE unsafeDrop #-} +unsafeDrop = G.unsafeDrop + +unsafeInit :: Unbox a => MVector s a -> MVector s a +{-# INLINE unsafeInit #-} +unsafeInit = G.unsafeInit + +unsafeTail :: Unbox a => MVector s a -> MVector s a +{-# INLINE unsafeTail #-} +unsafeTail = G.unsafeTail + +-- Overlapping +-- ----------- + +-- | Check whether two vectors overlap. +overlaps :: Unbox a => MVector s a -> MVector s a -> Bool +{-# INLINE overlaps #-} +overlaps = G.overlaps + +-- Initialisation +-- -------------- + +-- | Create a mutable vector of the given length. +new :: (PrimMonad m, Unbox a) => Int -> m (MVector (PrimState m) a) +{-# INLINE new #-} +new = G.new + +-- | Create a mutable vector of the given length. The memory is not initialized. +unsafeNew :: (PrimMonad m, Unbox a) => Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeNew #-} +unsafeNew = G.unsafeNew + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +replicate :: (PrimMonad m, Unbox a) => Int -> a -> m (MVector (PrimState m) a) +{-# INLINE replicate #-} +replicate = G.replicate + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +replicateM :: (PrimMonad m, Unbox a) => Int -> m a -> m (MVector (PrimState m) a) +{-# INLINE replicateM #-} +replicateM = G.replicateM + +-- | Create a copy of a mutable vector. +clone :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -> m (MVector (PrimState m) a) +{-# INLINE clone #-} +clone = G.clone + +-- Growing +-- ------- + +-- | Grow a vector by the given number of elements. The number must be +-- positive. +grow :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE grow #-} +grow = G.grow + +-- | Grow a vector by the given number of elements. The number must be +-- positive but this is not checked. +unsafeGrow :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) +{-# INLINE unsafeGrow #-} +unsafeGrow = G.unsafeGrow + +-- Restricting memory usage +-- ------------------------ + +-- | Reset all elements of the vector to some undefined value, clearing all +-- references to external objects. This is usually a noop for unboxed vectors. +clear :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> m () +{-# INLINE clear #-} +clear = G.clear + +-- Accessing individual elements +-- ----------------------------- + +-- | Yield the element at the given position. +read :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE read #-} +read = G.read + +-- | Replace the element at the given position. +write :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE write #-} +write = G.write + +-- | Modify the element at the given position. +modify :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE modify #-} +modify = G.modify + +-- | Swap the elements at the given positions. +swap :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE swap #-} +swap = G.swap + + +-- | Yield the element at the given position. No bounds checks are performed. +unsafeRead :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> m a +{-# INLINE unsafeRead #-} +unsafeRead = G.unsafeRead + +-- | Replace the element at the given position. No bounds checks are performed. +unsafeWrite + :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> a -> m () +{-# INLINE unsafeWrite #-} +unsafeWrite = G.unsafeWrite + +-- | Modify the element at the given position. No bounds checks are performed. +unsafeModify :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> (a -> a) -> Int -> m () +{-# INLINE unsafeModify #-} +unsafeModify = G.unsafeModify + +-- | Swap the elements at the given positions. No bounds checks are performed. +unsafeSwap + :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> Int -> Int -> m () +{-# INLINE unsafeSwap #-} +unsafeSwap = G.unsafeSwap + +-- Filling and copying +-- ------------------- + +-- | Set all elements of the vector to the given value. +set :: (PrimMonad m, Unbox a) => MVector (PrimState m) a -> a -> m () +{-# INLINE set #-} +set = G.set + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +copy :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE copy #-} +copy = G.copy + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. This is not checked. +unsafeCopy :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeCopy #-} +unsafeCopy = G.unsafeCopy + +-- | Move the contents of a vector. The two vectors must have the same +-- length. +-- +-- If the vectors do not overlap, then this is equivalent to 'copy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +move :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -> MVector (PrimState m) a -> m () +{-# INLINE move #-} +move = G.move + +-- | Move the contents of a vector. The two vectors must have the same +-- length, but this is not checked. +-- +-- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +unsafeMove :: (PrimMonad m, Unbox a) + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () +{-# INLINE unsafeMove #-} +unsafeMove = G.unsafeMove + +-- | Compute the next (lexicographically) permutation of given vector in-place. +-- Returns False when input is the last permtuation +nextPermutation :: (PrimMonad m,Ord e,Unbox e) => MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutation #-} +nextPermutation = G.nextPermutation + +#define DEFINE_MUTABLE +#include "unbox-tuple-instances" |