From 3ed0df23cb524cd6bf3af2a440ef96c524c5e27c Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Wed, 10 Apr 2024 19:36:53 +0300 Subject: [PATCH 01/14] Implement functions which use Applicatives generateA is used as primitive and all other functions are expressed in it terms. First version goes through intermediate list. This is simplest implementation possible and would serve as baseline for further optimizations --- vector/src/Data/Vector/Generic.hs | 38 +++++++++++++++++++++++++++++-- 1 file changed, 36 insertions(+), 2 deletions(-) diff --git a/vector/src/Data/Vector/Generic.hs b/vector/src/Data/Vector/Generic.hs index a8250b4d..1757adb6 100644 --- a/vector/src/Data/Vector/Generic.hs +++ b/vector/src/Data/Vector/Generic.hs @@ -145,6 +145,9 @@ module Data.Vector.Generic ( scanr, scanr', scanr1, scanr1', iscanr, iscanr', + -- * Applicative API + replicateA, generateA, traverse, itraverse, + -- * Conversions -- ** Lists @@ -197,7 +200,8 @@ import Data.Vector.Internal.Check import Control.Monad.ST ( ST, runST ) import Control.Monad.Primitive import Prelude - ( Eq, Ord, Num, Enum, Monoid, Monad, Read, Show, Bool, Ordering(..), Int, Maybe(..), Either, IO, ShowS, ReadS, String + ( Eq, Ord, Num, Enum, Monoid, Applicative, Monad, Read, Show, Bool, Ordering(..) + , Int, Maybe(..), Either, IO, ShowS, ReadS, String , compare, mempty, mappend, return, fmap, otherwise, id, flip, seq, error, undefined, uncurry, shows, fst, snd, min, max, not , (>>=), (+), (-), (*), (<), (==), (.), ($), (=<<), (>>), (<$>) ) @@ -210,7 +214,7 @@ import Data.Typeable ( Typeable, gcast1 ) import Data.Data ( Data, DataType, Constr, Fixity(Prefix), mkDataType, mkConstr, constrIndex, mkNoRepType ) -import qualified Data.Traversable as T (Traversable(mapM)) +import qualified Data.Traversable as T (Traversable(mapM,traverse)) -- Length information -- ------------------ @@ -2653,6 +2657,36 @@ clone v = v `seq` New.create ( unsafeCopy mv v return mv) +-- Applicatives +-- ------------ + +-- | Execute the applicative action the given number of times and store the +-- results in a vector. +replicateA :: (Vector v a, Applicative f) => Int -> f a -> f (v a) +{-# INLINE replicateA #-} +replicateA n f = generateA n (\_ -> f) + + +-- | Construct a vector of the given length by applying the monadic +-- action to each index. +generateA :: (Vector v a, Applicative f) => Int -> (Int -> f a) -> f (v a) +{-# INLINE generateA #-} +generateA n f = fromListN n <$> T.traverse f [0 .. n-1] + +-- | Apply the applicative action to all elements of the vector, yielding a +-- vector of results. +traverse :: (Vector v a, Vector v b, Applicative f) + => (a -> f b) -> v a -> f (v b) +{-# INLINE traverse #-} +traverse f v = generateA (length v) $ \i -> f (unsafeIndex v i) + +-- | Apply the applicative action to every element of a vector and its +-- index, yielding a vector of results. +itraverse :: (Vector v a, Vector v b, Applicative f) + => (Int -> a -> f b) -> v a -> f (v b) +{-# INLINE itraverse #-} +itraverse f v = generateA (length v) $ \i -> f i (unsafeIndex v i) + -- Comparisons -- ----------- From 503f52496776a44f3fe97fb5e31bbdb02089cc80 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Thu, 31 Oct 2024 22:10:50 +0300 Subject: [PATCH 02/14] First version of benchmarks for applicative functions We establish implementation which goes through list as baseline and the we can try to optimize it. Note definition of foldlOf'. It's different from definition in lens<=5.3.3 but it's absolutely necessary to get good perfomance in folds --- vector-bench-papi/benchmarks/Main.hs | 12 +++ .../benchlib/Bench/Vector/Algo/Applicative.hs | 101 ++++++++++++++++++ vector/benchmarks/Main.hs | 13 +++ vector/vector.cabal | 1 + 4 files changed, 127 insertions(+) create mode 100644 vector/benchlib/Bench/Vector/Algo/Applicative.hs diff --git a/vector-bench-papi/benchmarks/Main.hs b/vector-bench-papi/benchmarks/Main.hs index 590a7573..284e557f 100644 --- a/vector-bench-papi/benchmarks/Main.hs +++ b/vector-bench-papi/benchmarks/Main.hs @@ -12,6 +12,8 @@ import Bench.Vector.Algo.Spectral (spectral) import Bench.Vector.Algo.Tridiag (tridiag) import Bench.Vector.Algo.FindIndexR (findIndexR, findIndexR_naive, findIndexR_manual) import Bench.Vector.Algo.NextPermutation (generatePermTests) +import Bench.Vector.Algo.Applicative ( generateState, generateStateUnfold, generateIO, generateIOPrim + , lensSum, lensMap, baselineSum, baselineMap) import Bench.Vector.TestData.ParenTree (parenTree) import Bench.Vector.TestData.Graph (randomGraph) @@ -68,4 +70,14 @@ main = do , bench "minimumOn" $ whnf (U.minimumOn (\x -> x*x*x)) as , bench "maximumOn" $ whnf (U.maximumOn (\x -> x*x*x)) as , bgroup "(next|prev)Permutation" $ map (\(name, act) -> bench name $ whnfIO act) permTests + , bgroup "Applicative" + [ bench "generateState" $ whnf generateState useSize + , bench "generateStateUnfold" $ whnf generateStateUnfold useSize + , bench "generateIO" $ whnfIO (generateIO useSize) + , bench "generateIOPrim" $ whnfIO (generateIOPrim useSize) + , bench "sum[lens]" $ whnf lensSum as + , bench "sum[base]" $ whnf baselineSum as + , bench "map[lens]" $ whnf lensMap as + , bench "map[base]" $ whnf baselineMap as + ] ] diff --git a/vector/benchlib/Bench/Vector/Algo/Applicative.hs b/vector/benchlib/Bench/Vector/Algo/Applicative.hs new file mode 100644 index 00000000..06f4cd74 --- /dev/null +++ b/vector/benchlib/Bench/Vector/Algo/Applicative.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- | +-- This module provides benchmarks for functions which use API based +-- on applicative. We use @generateA@ based benchmark for state and IO +-- and also benchmark folds and mapping using lens since it's one of +-- important consumers of this API. +module Bench.Vector.Algo.Applicative + ( -- * Standard benchmarks + generateState + , generateStateUnfold + , generateIO + , generateIOPrim + -- * Lens benchmarks + , lensSum + , baselineSum + , lensMap + , baselineMap + ) where + +import Control.Applicative +import Data.Coerce +import Data.Functor.Identity +import Data.Int +import Data.Monoid +import Data.Word +import qualified Data.Vector.Generic as VG +import qualified Data.Vector.Generic.Mutable as MVG +import qualified Data.Vector.Unboxed as VU +import System.Random.Stateful +import System.Mem (getAllocationCounter) + +-- | Benchmark which is running in state monad. +generateState :: Int -> VU.Vector Word64 +generateState n + = runStateGen_ (mkStdGen 42) + $ \g -> VG.generateA n (\_ -> uniformM g) + +-- | Benchmark which is running in state monad. +generateStateUnfold :: Int -> VU.Vector Word64 +generateStateUnfold n = VU.unfoldrExactN n genWord64 (mkStdGen 42) + +-- | Benchmark for running @generateA@ in IO monad. +generateIO :: Int -> IO (VU.Vector Int64) +generateIO n = VG.generateA n (\_ -> getAllocationCounter) + +-- | Baseline for 'generateIO' it uses primitive operations +generateIOPrim :: Int -> IO (VU.Vector Int64) +generateIOPrim n = VG.unsafeFreeze =<< MVG.replicateM n getAllocationCounter + +-- | Sum using lens +lensSum :: VU.Vector Double -> Double +{-# NOINLINE lensSum #-} +lensSum = foldlOf' VG.traverse (+) 0 + +-- | Baseline for sum. +baselineSum :: VU.Vector Double -> Double +{-# NOINLINE baselineSum #-} +baselineSum = VU.sum + +-- | Mapping over vector elements using +lensMap :: VU.Vector Double -> VU.Vector Double +{-# NOINLINE lensMap #-} +lensMap = over VG.traverse (*2) + +-- | Baseline for map +baselineMap :: VU.Vector Double -> VU.Vector Double +{-# NOINLINE baselineMap #-} +baselineMap = VU.map (*2) + +---------------------------------------------------------------- +-- Bits and pieces of lens +-- +-- We don't want to depend on lens so we just copy relevant +-- parts. After all we don't need much +---------------------------------------------------------------- + +type ASetter s t a b = (a -> Identity b) -> s -> Identity t +type Getting r s a = (a -> Const r a) -> s -> Const r s + +foldlOf' :: Getting (Endo (Endo r)) s a -> (r -> a -> r) -> r -> s -> r +foldlOf' l f z0 = \xs -> + let f' x (Endo k) = Endo $ \z -> k $! f z x + in foldrOf l f' (Endo id) xs `appEndo` z0 +{-# INLINE foldlOf' #-} + +foldrOf :: Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r +foldrOf l f z = flip appEndo z . foldMapOf l (Endo #. f) +{-# INLINE foldrOf #-} + +foldMapOf :: Getting r s a -> (a -> r) -> s -> r +foldMapOf = coerce +{-# INLINE foldMapOf #-} + +( #. ) :: Coercible c b => (b -> c) -> (a -> b) -> (a -> c) +( #. ) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b +{-# INLINE (#.) #-} + +over :: ASetter s t a b -> (a -> b) -> s -> t +over = coerce +{-# INLINE over #-} diff --git a/vector/benchmarks/Main.hs b/vector/benchmarks/Main.hs index f8aad4ea..79adb3b9 100644 --- a/vector/benchmarks/Main.hs +++ b/vector/benchmarks/Main.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} module Main where + import Bench.Vector.Algo.MutableSet (mutableSet) import Bench.Vector.Algo.ListRank (listRank) import Bench.Vector.Algo.Rootfix (rootfix) @@ -12,6 +13,8 @@ import Bench.Vector.Algo.Spectral (spectral) import Bench.Vector.Algo.Tridiag (tridiag) import Bench.Vector.Algo.FindIndexR (findIndexR, findIndexR_naive, findIndexR_manual) import Bench.Vector.Algo.NextPermutation (generatePermTests) +import Bench.Vector.Algo.Applicative ( generateState, generateStateUnfold, generateIO, generateIOPrim + , lensSum, lensMap, baselineSum, baselineMap) import Bench.Vector.TestData.ParenTree (parenTree) import Bench.Vector.TestData.Graph (randomGraph) @@ -69,4 +72,14 @@ main = do , bench "minimumOn" $ whnf (U.minimumOn (\x -> x*x*x)) as , bench "maximumOn" $ whnf (U.maximumOn (\x -> x*x*x)) as , bgroup "(next|prev)Permutation" $ map (\(name, act) -> bench name $ whnfIO act) permTests + , bgroup "Applicative" + [ bench "generateState" $ whnf generateState useSize + , bench "generateStateUnfold" $ whnf generateStateUnfold useSize + , bench "generateIO" $ whnfIO (generateIO useSize) + , bench "generateIOPrim" $ whnfIO (generateIOPrim useSize) + , bench "sum[lens]" $ whnf lensSum as + , bench "sum[base]" $ whnf baselineSum as + , bench "map[lens]" $ whnf lensMap as + , bench "map[base]" $ whnf baselineMap as + ] ] diff --git a/vector/vector.cabal b/vector/vector.cabal index bb74c9b0..177dac34 100644 --- a/vector/vector.cabal +++ b/vector/vector.cabal @@ -289,6 +289,7 @@ library benchmarks-O2 Bench.Vector.Algo.Quickhull Bench.Vector.Algo.Spectral Bench.Vector.Algo.Tridiag + Bench.Vector.Algo.Applicative Bench.Vector.Algo.FindIndexR Bench.Vector.Algo.NextPermutation Bench.Vector.TestData.ParenTree From 8b1be887d0693da99e6d3f25755bd5d9ac07224f Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Wed, 17 Apr 2024 23:59:03 +0300 Subject: [PATCH 03/14] Implement STA optimization trick as an optimization Does wonders for traversals using Identity --- vector/src/Data/Vector/Generic.hs | 26 ++++++++++++++++++++++---- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/vector/src/Data/Vector/Generic.hs b/vector/src/Data/Vector/Generic.hs index 1757adb6..3e55470d 100644 --- a/vector/src/Data/Vector/Generic.hs +++ b/vector/src/Data/Vector/Generic.hs @@ -200,11 +200,10 @@ import Data.Vector.Internal.Check import Control.Monad.ST ( ST, runST ) import Control.Monad.Primitive import Prelude - ( Eq, Ord, Num, Enum, Monoid, Applicative, Monad, Read, Show, Bool, Ordering(..) + ( Eq(..), Ord(..), Num, Enum, Monoid, Applicative(..), Monad, Read, Show, Bool, Ordering(..) , Int, Maybe(..), Either, IO, ShowS, ReadS, String , compare, mempty, mappend, return, fmap, otherwise, id, flip, seq, error, undefined, uncurry, shows, fst, snd, min, max, not - , (>>=), (+), (-), (*), (<), (==), (.), ($), (=<<), (>>), (<$>) ) - + , (>>=), (+), (-), (*), (.), ($), (=<<), (>>), (<$>)) import qualified Text.Read as Read import qualified Data.List.NonEmpty as NonEmpty @@ -2660,6 +2659,19 @@ clone v = v `seq` New.create ( -- Applicatives -- ------------ + + +newtype STA v a = STA { + _runSTA :: forall s. Mutable v s a -> ST s (v a) +} + +runSTA :: Vector v a => Int -> STA v a -> v a +runSTA !sz = \(STA fun) -> runST $ fun =<< M.unsafeNew sz +{-# INLINE runSTA #-} + + + + -- | Execute the applicative action the given number of times and store the -- results in a vector. replicateA :: (Vector v a, Applicative f) => Int -> f a -> f (v a) @@ -2671,7 +2683,13 @@ replicateA n f = generateA n (\_ -> f) -- action to each index. generateA :: (Vector v a, Applicative f) => Int -> (Int -> f a) -> f (v a) {-# INLINE generateA #-} -generateA n f = fromListN n <$> T.traverse f [0 .. n-1] +generateA 0 _ = pure empty +generateA n f = runSTA n <$> go 0 + where + go !i | i >= n = pure $ STA unsafeFreeze + | otherwise = (\a (STA m) -> STA $ \mv -> M.unsafeWrite mv i a >> m mv) + <$> f i + <*> go (i + 1) -- | Apply the applicative action to all elements of the vector, yielding a -- vector of results. From a08bf3dcd1cea5065266511731b63d2030167ac5 Mon Sep 17 00:00:00 2001 From: Aleksey Khudyakov Date: Tue, 28 Jan 2025 17:27:07 +0300 Subject: [PATCH 04/14] Update vector/src/Data/Vector/Generic.hs Co-authored-by: konsumlamm <44230978+konsumlamm@users.noreply.github.com> --- vector/src/Data/Vector/Generic.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vector/src/Data/Vector/Generic.hs b/vector/src/Data/Vector/Generic.hs index 3e55470d..2bd81220 100644 --- a/vector/src/Data/Vector/Generic.hs +++ b/vector/src/Data/Vector/Generic.hs @@ -2679,7 +2679,7 @@ replicateA :: (Vector v a, Applicative f) => Int -> f a -> f (v a) replicateA n f = generateA n (\_ -> f) --- | Construct a vector of the given length by applying the monadic +-- | Construct a vector of the given length by applying the applicative -- action to each index. generateA :: (Vector v a, Applicative f) => Int -> (Int -> f a) -> f (v a) {-# INLINE generateA #-} From 10d112d290f2d7ce96719dce43f718bb73558737 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Tue, 2 Sep 2025 20:38:12 +0300 Subject: [PATCH 05/14] We don't need to return vector in STA No performance change in benchmarks --- vector/src/Data/Vector/Generic.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/vector/src/Data/Vector/Generic.hs b/vector/src/Data/Vector/Generic.hs index 2bd81220..992b948d 100644 --- a/vector/src/Data/Vector/Generic.hs +++ b/vector/src/Data/Vector/Generic.hs @@ -2662,11 +2662,14 @@ clone v = v `seq` New.create ( newtype STA v a = STA { - _runSTA :: forall s. Mutable v s a -> ST s (v a) + _runSTA :: forall s. Mutable v s a -> ST s () } runSTA :: Vector v a => Int -> STA v a -> v a -runSTA !sz = \(STA fun) -> runST $ fun =<< M.unsafeNew sz +runSTA !sz = \(STA fun) -> runST $ do + mv <- M.unsafeNew sz + fun mv + unsafeFreeze mv {-# INLINE runSTA #-} @@ -2678,7 +2681,6 @@ replicateA :: (Vector v a, Applicative f) => Int -> f a -> f (v a) {-# INLINE replicateA #-} replicateA n f = generateA n (\_ -> f) - -- | Construct a vector of the given length by applying the applicative -- action to each index. generateA :: (Vector v a, Applicative f) => Int -> (Int -> f a) -> f (v a) @@ -2686,7 +2688,7 @@ generateA :: (Vector v a, Applicative f) => Int -> (Int -> f a) -> f (v a) generateA 0 _ = pure empty generateA n f = runSTA n <$> go 0 where - go !i | i >= n = pure $ STA unsafeFreeze + go !i | i >= n = pure $ STA $ \_ -> pure () | otherwise = (\a (STA m) -> STA $ \mv -> M.unsafeWrite mv i a >> m mv) <$> f i <*> go (i + 1) From 49503fc48fbfae5ab16c73589c092b4422642224 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Tue, 2 Sep 2025 20:48:01 +0300 Subject: [PATCH 06/14] Add rewrite rules for IO, ST, and Identity This is clearly not enough. There're many other types that will benefit form same rewrite but we don't know how to do that. unstreamM suffers from same problem. Identity is important since it's used in lens for mapping (over) and rewrite rule does improve performance: 10-20% in microbenchmark. --- vector/src/Data/Vector/Generic.hs | 45 ++++++++++++++++++++++++------- 1 file changed, 35 insertions(+), 10 deletions(-) diff --git a/vector/src/Data/Vector/Generic.hs b/vector/src/Data/Vector/Generic.hs index 992b948d..b9a9436d 100644 --- a/vector/src/Data/Vector/Generic.hs +++ b/vector/src/Data/Vector/Generic.hs @@ -5,6 +5,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} -- | -- Module : Data.Vector.Generic -- Copyright : (c) Roman Leshchinskiy 2008-2010 @@ -199,6 +200,7 @@ import Data.Vector.Internal.Check import Control.Monad.ST ( ST, runST ) import Control.Monad.Primitive +import Data.Functor.Identity (Identity(..)) import Prelude ( Eq(..), Ord(..), Num, Enum, Monoid, Applicative(..), Monad, Read, Show, Bool, Ordering(..) , Int, Maybe(..), Either, IO, ShowS, ReadS, String @@ -2673,18 +2675,10 @@ runSTA !sz = \(STA fun) -> runST $ do {-# INLINE runSTA #-} - - --- | Execute the applicative action the given number of times and store the --- results in a vector. -replicateA :: (Vector v a, Applicative f) => Int -> f a -> f (v a) -{-# INLINE replicateA #-} -replicateA n f = generateA n (\_ -> f) - -- | Construct a vector of the given length by applying the applicative -- action to each index. -generateA :: (Vector v a, Applicative f) => Int -> (Int -> f a) -> f (v a) -{-# INLINE generateA #-} +generateA :: (Applicative f, Vector v a) => Int -> (Int -> f a) -> f (v a) +{-# INLINE[1] generateA #-} generateA 0 _ = pure empty generateA n f = runSTA n <$> go 0 where @@ -2693,6 +2687,37 @@ generateA n f = runSTA n <$> go 0 <$> f i <*> go (i + 1) +unsafeGeneratePrim :: (PrimMonad m, Vector v a) => Int -> (Int -> m a) -> m (v a) +{-# INLINE unsafeGeneratePrim #-} +unsafeGeneratePrim n f = unsafeFreeze =<< M.generateM n f + +generateA_IO :: (Vector v a) => Int -> (Int -> IO a) -> IO (v a) +{-# INLINE generateA_IO #-} +generateA_IO = unsafeGeneratePrim + +generateA_ST :: (Vector v a) => Int -> (Int -> ST s a) -> ST s (v a) +{-# INLINE generateA_ST #-} +generateA_ST = unsafeGeneratePrim + +generateA_Identity :: (Vector v a) => Int -> (Int -> Identity a) -> Identity (v a) +{-# INLINE generateA_Identity #-} +generateA_Identity n f = Identity (generate n (runIdentity . f)) + + +{-# RULES + +"generateA[IO]" generateA = generateA_IO +"generateA[ST]" generateA = generateA_ST +"generateA[Identity]" generateA = generateA_Identity + #-} + + +-- | Execute the applicative action the given number of times and store the +-- results in a vector. +replicateA :: (Vector v a, Applicative f) => Int -> f a -> f (v a) +{-# INLINE replicateA #-} +replicateA n f = generateA n (\_ -> f) + -- | Apply the applicative action to all elements of the vector, yielding a -- vector of results. traverse :: (Vector v a, Vector v b, Applicative f) From a6bd2a5bb3154fe6cafbfce1f1241daf2f17bb38 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 5 Sep 2025 09:56:14 +0300 Subject: [PATCH 07/14] Add function which discard result of applicative action --- vector/src/Data/Vector/Generic.hs | 49 +++++++++++++++++++++++++++++-- 1 file changed, 47 insertions(+), 2 deletions(-) diff --git a/vector/src/Data/Vector/Generic.hs b/vector/src/Data/Vector/Generic.hs index b9a9436d..fc69366e 100644 --- a/vector/src/Data/Vector/Generic.hs +++ b/vector/src/Data/Vector/Generic.hs @@ -147,7 +147,8 @@ module Data.Vector.Generic ( iscanr, iscanr', -- * Applicative API - replicateA, generateA, traverse, itraverse, + replicateA, generateA, traverse, itraverse, forA, iforA, + traverse_, itraverse_, forA_, iforA_, -- * Conversions @@ -215,7 +216,7 @@ import Data.Typeable ( Typeable, gcast1 ) import Data.Data ( Data, DataType, Constr, Fixity(Prefix), mkDataType, mkConstr, constrIndex, mkNoRepType ) -import qualified Data.Traversable as T (Traversable(mapM,traverse)) +import qualified Data.Traversable as T (Traversable(mapM)) -- Length information -- ------------------ @@ -2732,6 +2733,50 @@ itraverse :: (Vector v a, Vector v b, Applicative f) {-# INLINE itraverse #-} itraverse f v = generateA (length v) $ \i -> f i (unsafeIndex v i) +-- | Apply the applicative action to all elements of the vector, yielding a +-- vector of results. This is flipped version of 'traverse'. +forA :: (Vector v a, Vector v b, Applicative f) + => v a -> (a -> f b) -> f (v b) +{-# INLINE forA #-} +forA v f = generateA (length v) $ \i -> f (unsafeIndex v i) + +-- | Apply the applicative action to every element of a vector and its +-- index, yielding a vector of results. This is flipped version of 'itraverse'. +iforA :: (Vector v a, Vector v b, Applicative f) + => v a -> (Int -> a -> f b) -> f (v b) +{-# INLINE iforA #-} +iforA v f = generateA (length v) $ \i -> f i (unsafeIndex v i) + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +traverse_ :: (Vector v a, Applicative f) + => (a -> f b) -> v a -> f () +{-# INLINE traverse_ #-} +traverse_ f = foldr step (pure ()) + where step x k = f x *> k + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +itraverse_ :: (Vector v a, Applicative f) + => (Int -> a -> f b) -> v a -> f () +{-# INLINE itraverse_ #-} +itraverse_ f = ifoldr step (pure ()) + where step i x k = f i x *> k + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +forA_ :: (Vector v a, Applicative f) + => v a -> (a -> f b) -> f () +{-# INLINE forA_ #-} +forA_ = flip traverse_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +iforA_ :: (Vector v a, Applicative f) + => v a -> (Int -> a -> f b) -> f () +{-# INLINE iforA_ #-} +iforA_ = flip itraverse_ + -- Comparisons -- ----------- From 9881b634deee7c141e6d03fc6ab3566e3ff12936 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 5 Sep 2025 09:58:09 +0300 Subject: [PATCH 08/14] Put Applicative in first place in context Relevant for TypeApplication and other function library use same convention --- vector/src/Data/Vector/Generic.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/vector/src/Data/Vector/Generic.hs b/vector/src/Data/Vector/Generic.hs index fc69366e..79c25066 100644 --- a/vector/src/Data/Vector/Generic.hs +++ b/vector/src/Data/Vector/Generic.hs @@ -2715,41 +2715,41 @@ generateA_Identity n f = Identity (generate n (runIdentity . f)) -- | Execute the applicative action the given number of times and store the -- results in a vector. -replicateA :: (Vector v a, Applicative f) => Int -> f a -> f (v a) +replicateA :: (Applicative f, Vector v a) => Int -> f a -> f (v a) {-# INLINE replicateA #-} replicateA n f = generateA n (\_ -> f) -- | Apply the applicative action to all elements of the vector, yielding a -- vector of results. -traverse :: (Vector v a, Vector v b, Applicative f) +traverse :: (Applicative f, Vector v a, Vector v b) => (a -> f b) -> v a -> f (v b) {-# INLINE traverse #-} traverse f v = generateA (length v) $ \i -> f (unsafeIndex v i) -- | Apply the applicative action to every element of a vector and its -- index, yielding a vector of results. -itraverse :: (Vector v a, Vector v b, Applicative f) +itraverse :: (Applicative f, Vector v a, Vector v b) => (Int -> a -> f b) -> v a -> f (v b) {-# INLINE itraverse #-} itraverse f v = generateA (length v) $ \i -> f i (unsafeIndex v i) -- | Apply the applicative action to all elements of the vector, yielding a -- vector of results. This is flipped version of 'traverse'. -forA :: (Vector v a, Vector v b, Applicative f) +forA :: (Applicative f, Vector v a, Vector v b) => v a -> (a -> f b) -> f (v b) {-# INLINE forA #-} forA v f = generateA (length v) $ \i -> f (unsafeIndex v i) -- | Apply the applicative action to every element of a vector and its -- index, yielding a vector of results. This is flipped version of 'itraverse'. -iforA :: (Vector v a, Vector v b, Applicative f) +iforA :: (Applicative f, Vector v a, Vector v b) => v a -> (Int -> a -> f b) -> f (v b) {-# INLINE iforA #-} iforA v f = generateA (length v) $ \i -> f i (unsafeIndex v i) -- | Map each element of a structure to an 'Applicative' action, evaluate these -- actions from left to right, and ignore the results. -traverse_ :: (Vector v a, Applicative f) +traverse_ :: (Applicative f, Vector v a) => (a -> f b) -> v a -> f () {-# INLINE traverse_ #-} traverse_ f = foldr step (pure ()) @@ -2757,7 +2757,7 @@ traverse_ f = foldr step (pure ()) -- | Map each element of a structure to an 'Applicative' action, evaluate these -- actions from left to right, and ignore the results. -itraverse_ :: (Vector v a, Applicative f) +itraverse_ :: (Applicative f, Vector v a) => (Int -> a -> f b) -> v a -> f () {-# INLINE itraverse_ #-} itraverse_ f = ifoldr step (pure ()) @@ -2765,14 +2765,14 @@ itraverse_ f = ifoldr step (pure ()) -- | Map each element of a structure to an 'Applicative' action, evaluate these -- actions from left to right, and ignore the results. -forA_ :: (Vector v a, Applicative f) +forA_ :: (Applicative f, Vector v a) => v a -> (a -> f b) -> f () {-# INLINE forA_ #-} forA_ = flip traverse_ -- | Map each element of a structure to an 'Applicative' action, evaluate these -- actions from left to right, and ignore the results. -iforA_ :: (Vector v a, Applicative f) +iforA_ :: (Applicative f, Vector v a) => v a -> (Int -> a -> f b) -> f () {-# INLINE iforA_ #-} iforA_ = flip itraverse_ From 37b674cd76065f8d573ebb8db1aa4dc18cc97598 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 5 Sep 2025 10:17:47 +0300 Subject: [PATCH 09/14] Add reexports --- vector/src/Data/Vector.hs | 96 ++++++++++++++++++++++++++++ vector/src/Data/Vector/Generic.hs | 22 +++++++ vector/src/Data/Vector/Primitive.hs | 97 +++++++++++++++++++++++++++++ vector/src/Data/Vector/Storable.hs | 97 +++++++++++++++++++++++++++++ vector/src/Data/Vector/Strict.hs | 96 ++++++++++++++++++++++++++++ vector/src/Data/Vector/Unboxed.hs | 97 +++++++++++++++++++++++++++++ 6 files changed, 505 insertions(+) diff --git a/vector/src/Data/Vector.hs b/vector/src/Data/Vector.hs index 8ea3ca4d..cc7112d9 100644 --- a/vector/src/Data/Vector.hs +++ b/vector/src/Data/Vector.hs @@ -156,6 +156,10 @@ module Data.Vector ( scanr, scanr', scanr1, scanr1', iscanr, iscanr', + -- * Applicative API + replicateA, generateA, traverse, itraverse, forA, iforA, + traverse_, itraverse_, forA_, iforA_, + -- ** Comparisons eqBy, cmpBy, @@ -174,6 +178,7 @@ module Data.Vector ( freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy ) where +import Control.Applicative (Applicative) import Data.Vector.Mutable ( MVector(..) ) import Data.Primitive.Array import qualified Data.Vector.Fusion.Bundle as Bundle @@ -2205,6 +2210,97 @@ fromListN :: Int -> [a] -> Vector a {-# INLINE fromListN #-} fromListN = G.fromListN +-- Applicative +-- ----------- + +-- | Construct a vector of the given length by applying the applicative +-- action to each index. +-- +-- @since NEXT_VERSION +generateA :: (Applicative f) => Int -> (Int -> f a) -> f (Vector a) +generateA = G.generateA + +-- | Execute the applicative action the given number of times and store the +-- results in a vector. +-- +-- @since NEXT_VERSION +replicateA :: (Applicative f) => Int -> f a -> f (Vector a) +{-# INLINE replicateA #-} +replicateA = G.replicateA + +-- | Apply the applicative action to all elements of the vector, yielding a +-- vector of results. +-- +-- @since NEXT_VERSION +traverse :: (Applicative f) + => (a -> f b) -> Vector a -> f (Vector b) +{-# INLINE traverse #-} +traverse = G.traverse + +-- | Apply the applicative action to every element of a vector and its +-- index, yielding a vector of results. +-- +-- @since NEXT_VERSION +itraverse :: (Applicative f) + => (Int -> a -> f b) -> Vector a -> f (Vector b) +{-# INLINE itraverse #-} +itraverse = G.itraverse + +-- | Apply the applicative action to all elements of the vector, yielding a +-- vector of results. This is flipped version of 'traverse'. +-- +-- @since NEXT_VERSION +forA :: (Applicative f) + => Vector a -> (a -> f b) -> f (Vector b) +{-# INLINE forA #-} +forA = G.forA + +-- | Apply the applicative action to every element of a vector and its +-- index, yielding a vector of results. This is flipped version of 'itraverse'. +-- +-- @since NEXT_VERSION +iforA :: (Applicative f) + => Vector a -> (Int -> a -> f b) -> f (Vector b) +{-# INLINE iforA #-} +iforA = G.iforA + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +traverse_ :: (Applicative f) + => (a -> f b) -> Vector a -> f () +{-# INLINE traverse_ #-} +traverse_ = G.traverse_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +itraverse_ :: (Applicative f) + => (Int -> a -> f b) -> Vector a -> f () +{-# INLINE itraverse_ #-} +itraverse_ = G.itraverse_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +forA_ :: (Applicative f) + => Vector a -> (a -> f b) -> f () +{-# INLINE forA_ #-} +forA_ = G.forA_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +iforA_ :: (Applicative f) + => Vector a -> (Int -> a -> f b) -> f () +{-# INLINE iforA_ #-} +iforA_ = G.iforA_ + + -- Conversions - Arrays -- ----------------------------- diff --git a/vector/src/Data/Vector/Generic.hs b/vector/src/Data/Vector/Generic.hs index 79c25066..6b1e5f31 100644 --- a/vector/src/Data/Vector/Generic.hs +++ b/vector/src/Data/Vector/Generic.hs @@ -2678,6 +2678,8 @@ runSTA !sz = \(STA fun) -> runST $ do -- | Construct a vector of the given length by applying the applicative -- action to each index. +-- +-- @since NEXT_VERSION generateA :: (Applicative f, Vector v a) => Int -> (Int -> f a) -> f (v a) {-# INLINE[1] generateA #-} generateA 0 _ = pure empty @@ -2700,6 +2702,8 @@ generateA_ST :: (Vector v a) => Int -> (Int -> ST s a) -> ST s (v a) {-# INLINE generateA_ST #-} generateA_ST = unsafeGeneratePrim +-- Identity is used in lest for mapping over structures. So it's +-- relatively important case. generateA_Identity :: (Vector v a) => Int -> (Int -> Identity a) -> Identity (v a) {-# INLINE generateA_Identity #-} generateA_Identity n f = Identity (generate n (runIdentity . f)) @@ -2715,12 +2719,16 @@ generateA_Identity n f = Identity (generate n (runIdentity . f)) -- | Execute the applicative action the given number of times and store the -- results in a vector. +-- +-- @since NEXT_VERSION replicateA :: (Applicative f, Vector v a) => Int -> f a -> f (v a) {-# INLINE replicateA #-} replicateA n f = generateA n (\_ -> f) -- | Apply the applicative action to all elements of the vector, yielding a -- vector of results. +-- +-- @since NEXT_VERSION traverse :: (Applicative f, Vector v a, Vector v b) => (a -> f b) -> v a -> f (v b) {-# INLINE traverse #-} @@ -2728,6 +2736,8 @@ traverse f v = generateA (length v) $ \i -> f (unsafeIndex v i) -- | Apply the applicative action to every element of a vector and its -- index, yielding a vector of results. +-- +-- @since NEXT_VERSION itraverse :: (Applicative f, Vector v a, Vector v b) => (Int -> a -> f b) -> v a -> f (v b) {-# INLINE itraverse #-} @@ -2735,6 +2745,8 @@ itraverse f v = generateA (length v) $ \i -> f i (unsafeIndex v i) -- | Apply the applicative action to all elements of the vector, yielding a -- vector of results. This is flipped version of 'traverse'. +-- +-- @since NEXT_VERSION forA :: (Applicative f, Vector v a, Vector v b) => v a -> (a -> f b) -> f (v b) {-# INLINE forA #-} @@ -2742,6 +2754,8 @@ forA v f = generateA (length v) $ \i -> f (unsafeIndex v i) -- | Apply the applicative action to every element of a vector and its -- index, yielding a vector of results. This is flipped version of 'itraverse'. +-- +-- @since NEXT_VERSION iforA :: (Applicative f, Vector v a, Vector v b) => v a -> (Int -> a -> f b) -> f (v b) {-# INLINE iforA #-} @@ -2749,6 +2763,8 @@ iforA v f = generateA (length v) $ \i -> f i (unsafeIndex v i) -- | Map each element of a structure to an 'Applicative' action, evaluate these -- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION traverse_ :: (Applicative f, Vector v a) => (a -> f b) -> v a -> f () {-# INLINE traverse_ #-} @@ -2757,6 +2773,8 @@ traverse_ f = foldr step (pure ()) -- | Map each element of a structure to an 'Applicative' action, evaluate these -- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION itraverse_ :: (Applicative f, Vector v a) => (Int -> a -> f b) -> v a -> f () {-# INLINE itraverse_ #-} @@ -2765,6 +2783,8 @@ itraverse_ f = ifoldr step (pure ()) -- | Map each element of a structure to an 'Applicative' action, evaluate these -- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION forA_ :: (Applicative f, Vector v a) => v a -> (a -> f b) -> f () {-# INLINE forA_ #-} @@ -2772,6 +2792,8 @@ forA_ = flip traverse_ -- | Map each element of a structure to an 'Applicative' action, evaluate these -- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION iforA_ :: (Applicative f, Vector v a) => v a -> (Int -> a -> f b) -> f () {-# INLINE iforA_ #-} diff --git a/vector/src/Data/Vector/Primitive.hs b/vector/src/Data/Vector/Primitive.hs index 7e23ea61..a0b81680 100644 --- a/vector/src/Data/Vector/Primitive.hs +++ b/vector/src/Data/Vector/Primitive.hs @@ -138,6 +138,10 @@ module Data.Vector.Primitive ( scanr, scanr', scanr1, scanr1', iscanr, iscanr', + -- * Applicative API + replicateA, generateA, traverse, itraverse, forA, iforA, + traverse_, itraverse_, forA_, iforA_, + -- ** Comparisons eqBy, cmpBy, @@ -157,6 +161,7 @@ module Data.Vector.Primitive ( Prim ) where +import Control.Applicative (Applicative) import qualified Data.Vector.Generic as G import Data.Vector.Primitive.Mutable ( MVector(..) ) import Data.Vector.Internal.Check @@ -1875,6 +1880,98 @@ fromListN :: Prim a => Int -> [a] -> Vector a {-# INLINE fromListN #-} fromListN = G.fromListN + +-- Applicative +-- ----------- + +-- | Construct a vector of the given length by applying the applicative +-- action to each index. +-- +-- @since NEXT_VERSION +generateA :: (Applicative f, Prim a) => Int -> (Int -> f a) -> f (Vector a) +generateA = G.generateA + +-- | Execute the applicative action the given number of times and store the +-- results in a vector. +-- +-- @since NEXT_VERSION +replicateA :: (Applicative f, Prim a) => Int -> f a -> f (Vector a) +{-# INLINE replicateA #-} +replicateA = G.replicateA + +-- | Apply the applicative action to all elements of the vector, yielding a +-- vector of results. +-- +-- @since NEXT_VERSION +traverse :: (Applicative f, Prim a, Prim b) + => (a -> f b) -> Vector a -> f (Vector b) +{-# INLINE traverse #-} +traverse = G.traverse + +-- | Apply the applicative action to every element of a vector and its +-- index, yielding a vector of results. +-- +-- @since NEXT_VERSION +itraverse :: (Applicative f, Prim a, Prim b) + => (Int -> a -> f b) -> Vector a -> f (Vector b) +{-# INLINE itraverse #-} +itraverse = G.itraverse + +-- | Apply the applicative action to all elements of the vector, yielding a +-- vector of results. This is flipped version of 'traverse'. +-- +-- @since NEXT_VERSION +forA :: (Applicative f, Prim a, Prim b) + => Vector a -> (a -> f b) -> f (Vector b) +{-# INLINE forA #-} +forA = G.forA + +-- | Apply the applicative action to every element of a vector and its +-- index, yielding a vector of results. This is flipped version of 'itraverse'. +-- +-- @since NEXT_VERSION +iforA :: (Applicative f, Prim a, Prim b) + => Vector a -> (Int -> a -> f b) -> f (Vector b) +{-# INLINE iforA #-} +iforA = G.iforA + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +traverse_ :: (Applicative f, Prim a) + => (a -> f b) -> Vector a -> f () +{-# INLINE traverse_ #-} +traverse_ = G.traverse_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +itraverse_ :: (Applicative f, Prim a) + => (Int -> a -> f b) -> Vector a -> f () +{-# INLINE itraverse_ #-} +itraverse_ = G.itraverse_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +forA_ :: (Applicative f, Prim a) + => Vector a -> (a -> f b) -> f () +{-# INLINE forA_ #-} +forA_ = G.forA_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +iforA_ :: (Applicative f, Prim a) + => Vector a -> (Int -> a -> f b) -> f () +{-# INLINE iforA_ #-} +iforA_ = G.iforA_ + + -- Conversions - Unsafe casts -- -------------------------- diff --git a/vector/src/Data/Vector/Storable.hs b/vector/src/Data/Vector/Storable.hs index 65565b05..597c8ad7 100644 --- a/vector/src/Data/Vector/Storable.hs +++ b/vector/src/Data/Vector/Storable.hs @@ -135,6 +135,10 @@ module Data.Vector.Storable ( scanr, scanr', scanr1, scanr1', iscanr, iscanr', + -- * Applicative API + replicateA, generateA, traverse, itraverse, forA, iforA, + traverse_, itraverse_, forA_, iforA_, + -- ** Comparisons eqBy, cmpBy, @@ -163,6 +167,7 @@ module Data.Vector.Storable ( Storable ) where +import Control.Applicative (Applicative) import qualified Data.Vector.Generic as G import Data.Vector.Storable.Mutable ( MVector(..) ) import Data.Vector.Storable.Internal @@ -1921,6 +1926,98 @@ fromListN :: Storable a => Int -> [a] -> Vector a {-# INLINE fromListN #-} fromListN = G.fromListN + +-- Applicative +-- ----------- + +-- | Construct a vector of the given length by applying the applicative +-- action to each index. +-- +-- @since NEXT_VERSION +generateA :: (Applicative f, Storable a) => Int -> (Int -> f a) -> f (Vector a) +generateA = G.generateA + +-- | Execute the applicative action the given number of times and store the +-- results in a vector. +-- +-- @since NEXT_VERSION +replicateA :: (Applicative f, Storable a) => Int -> f a -> f (Vector a) +{-# INLINE replicateA #-} +replicateA = G.replicateA + +-- | Apply the applicative action to all elements of the vector, yielding a +-- vector of results. +-- +-- @since NEXT_VERSION +traverse :: (Applicative f, Storable a, Storable b) + => (a -> f b) -> Vector a -> f (Vector b) +{-# INLINE traverse #-} +traverse = G.traverse + +-- | Apply the applicative action to every element of a vector and its +-- index, yielding a vector of results. +-- +-- @since NEXT_VERSION +itraverse :: (Applicative f, Storable a, Storable b) + => (Int -> a -> f b) -> Vector a -> f (Vector b) +{-# INLINE itraverse #-} +itraverse = G.itraverse + +-- | Apply the applicative action to all elements of the vector, yielding a +-- vector of results. This is flipped version of 'traverse'. +-- +-- @since NEXT_VERSION +forA :: (Applicative f, Storable a, Storable b) + => Vector a -> (a -> f b) -> f (Vector b) +{-# INLINE forA #-} +forA = G.forA + +-- | Apply the applicative action to every element of a vector and its +-- index, yielding a vector of results. This is flipped version of 'itraverse'. +-- +-- @since NEXT_VERSION +iforA :: (Applicative f, Storable a, Storable b) + => Vector a -> (Int -> a -> f b) -> f (Vector b) +{-# INLINE iforA #-} +iforA = G.iforA + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +traverse_ :: (Applicative f, Storable a) + => (a -> f b) -> Vector a -> f () +{-# INLINE traverse_ #-} +traverse_ = G.traverse_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +itraverse_ :: (Applicative f, Storable a) + => (Int -> a -> f b) -> Vector a -> f () +{-# INLINE itraverse_ #-} +itraverse_ = G.itraverse_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +forA_ :: (Applicative f, Storable a) + => Vector a -> (a -> f b) -> f () +{-# INLINE forA_ #-} +forA_ = G.forA_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +iforA_ :: (Applicative f, Storable a) + => Vector a -> (Int -> a -> f b) -> f () +{-# INLINE iforA_ #-} +iforA_ = G.iforA_ + + -- Conversions - Unsafe casts -- -------------------------- diff --git a/vector/src/Data/Vector/Strict.hs b/vector/src/Data/Vector/Strict.hs index c6c3eb3a..ece68780 100644 --- a/vector/src/Data/Vector/Strict.hs +++ b/vector/src/Data/Vector/Strict.hs @@ -154,6 +154,10 @@ module Data.Vector.Strict ( scanr, scanr', scanr1, scanr1', iscanr, iscanr', + -- * Applicative API + replicateA, generateA, traverse, itraverse, forA, iforA, + traverse_, itraverse_, forA_, iforA_, + -- ** Comparisons eqBy, cmpBy, @@ -173,6 +177,7 @@ module Data.Vector.Strict ( freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy ) where +import Control.Applicative (Applicative) import Data.Coerce import Data.Vector.Strict.Mutable ( MVector(..) ) import Data.Primitive.Array @@ -2477,6 +2482,97 @@ fromListN :: Int -> [a] -> Vector a {-# INLINE fromListN #-} fromListN = G.fromListN +-- Applicative +-- ----------- + +-- | Construct a vector of the given length by applying the applicative +-- action to each index. +-- +-- @since NEXT_VERSION +generateA :: (Applicative f) => Int -> (Int -> f a) -> f (Vector a) +generateA = G.generateA + +-- | Execute the applicative action the given number of times and store the +-- results in a vector. +-- +-- @since NEXT_VERSION +replicateA :: (Applicative f) => Int -> f a -> f (Vector a) +{-# INLINE replicateA #-} +replicateA = G.replicateA + +-- | Apply the applicative action to all elements of the vector, yielding a +-- vector of results. +-- +-- @since NEXT_VERSION +traverse :: (Applicative f) + => (a -> f b) -> Vector a -> f (Vector b) +{-# INLINE traverse #-} +traverse = G.traverse + +-- | Apply the applicative action to every element of a vector and its +-- index, yielding a vector of results. +-- +-- @since NEXT_VERSION +itraverse :: (Applicative f) + => (Int -> a -> f b) -> Vector a -> f (Vector b) +{-# INLINE itraverse #-} +itraverse = G.itraverse + +-- | Apply the applicative action to all elements of the vector, yielding a +-- vector of results. This is flipped version of 'traverse'. +-- +-- @since NEXT_VERSION +forA :: (Applicative f) + => Vector a -> (a -> f b) -> f (Vector b) +{-# INLINE forA #-} +forA = G.forA + +-- | Apply the applicative action to every element of a vector and its +-- index, yielding a vector of results. This is flipped version of 'itraverse'. +-- +-- @since NEXT_VERSION +iforA :: (Applicative f) + => Vector a -> (Int -> a -> f b) -> f (Vector b) +{-# INLINE iforA #-} +iforA = G.iforA + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +traverse_ :: (Applicative f) + => (a -> f b) -> Vector a -> f () +{-# INLINE traverse_ #-} +traverse_ = G.traverse_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +itraverse_ :: (Applicative f) + => (Int -> a -> f b) -> Vector a -> f () +{-# INLINE itraverse_ #-} +itraverse_ = G.itraverse_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +forA_ :: (Applicative f) + => Vector a -> (a -> f b) -> f () +{-# INLINE forA_ #-} +forA_ = G.forA_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +iforA_ :: (Applicative f) + => Vector a -> (Int -> a -> f b) -> f () +{-# INLINE iforA_ #-} +iforA_ = G.iforA_ + + -- Conversions - Lazy vectors -- ----------------------------- diff --git a/vector/src/Data/Vector/Unboxed.hs b/vector/src/Data/Vector/Unboxed.hs index 57ee1118..a1f356bd 100644 --- a/vector/src/Data/Vector/Unboxed.hs +++ b/vector/src/Data/Vector/Unboxed.hs @@ -193,6 +193,10 @@ module Data.Vector.Unboxed ( scanr, scanr', scanr1, scanr1', iscanr, iscanr', + -- * Applicative API + replicateA, generateA, traverse, itraverse, forA, iforA, + traverse_, itraverse_, forA_, iforA_, + -- ** Comparisons eqBy, cmpBy, @@ -221,6 +225,7 @@ module Data.Vector.Unboxed ( DoNotUnboxNormalForm(..) ) where +import Control.Applicative (Applicative) import Data.Vector.Unboxed.Base import qualified Data.Vector.Generic as G import qualified Data.Vector.Fusion.Bundle as Bundle @@ -2012,6 +2017,98 @@ fromListN :: Unbox a => Int -> [a] -> Vector a {-# INLINE fromListN #-} fromListN = G.fromListN + +-- Applicative +-- ----------- + +-- | Construct a vector of the given length by applying the applicative +-- action to each index. +-- +-- @since NEXT_VERSION +generateA :: (Applicative f, Unbox a) => Int -> (Int -> f a) -> f (Vector a) +generateA = G.generateA + +-- | Execute the applicative action the given number of times and store the +-- results in a vector. +-- +-- @since NEXT_VERSION +replicateA :: (Applicative f, Unbox a) => Int -> f a -> f (Vector a) +{-# INLINE replicateA #-} +replicateA = G.replicateA + +-- | Apply the applicative action to all elements of the vector, yielding a +-- vector of results. +-- +-- @since NEXT_VERSION +traverse :: (Applicative f, Unbox a, Unbox b) + => (a -> f b) -> Vector a -> f (Vector b) +{-# INLINE traverse #-} +traverse = G.traverse + +-- | Apply the applicative action to every element of a vector and its +-- index, yielding a vector of results. +-- +-- @since NEXT_VERSION +itraverse :: (Applicative f, Unbox a, Unbox b) + => (Int -> a -> f b) -> Vector a -> f (Vector b) +{-# INLINE itraverse #-} +itraverse = G.itraverse + +-- | Apply the applicative action to all elements of the vector, yielding a +-- vector of results. This is flipped version of 'traverse'. +-- +-- @since NEXT_VERSION +forA :: (Applicative f, Unbox a, Unbox b) + => Vector a -> (a -> f b) -> f (Vector b) +{-# INLINE forA #-} +forA = G.forA + +-- | Apply the applicative action to every element of a vector and its +-- index, yielding a vector of results. This is flipped version of 'itraverse'. +-- +-- @since NEXT_VERSION +iforA :: (Applicative f, Unbox a, Unbox b) + => Vector a -> (Int -> a -> f b) -> f (Vector b) +{-# INLINE iforA #-} +iforA = G.iforA + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +traverse_ :: (Applicative f, Unbox a) + => (a -> f b) -> Vector a -> f () +{-# INLINE traverse_ #-} +traverse_ = G.traverse_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +itraverse_ :: (Applicative f, Unbox a) + => (Int -> a -> f b) -> Vector a -> f () +{-# INLINE itraverse_ #-} +itraverse_ = G.itraverse_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +forA_ :: (Applicative f, Unbox a) + => Vector a -> (a -> f b) -> f () +{-# INLINE forA_ #-} +forA_ = G.forA_ + +-- | Map each element of a structure to an 'Applicative' action, evaluate these +-- actions from left to right, and ignore the results. +-- +-- @since NEXT_VERSION +iforA_ :: (Applicative f, Unbox a) + => Vector a -> (Int -> a -> f b) -> f () +{-# INLINE iforA_ #-} +iforA_ = G.iforA_ + + -- Conversions - Mutable vectors -- ----------------------------- From 701f0a4bfa18ad2ae07936517c7cf6adc40d9276 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 5 Sep 2025 10:30:06 +0300 Subject: [PATCH 10/14] Update changelog --- vector/changelog.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/vector/changelog.md b/vector/changelog.md index b169f9be..2259a7ff 100644 --- a/vector/changelog.md +++ b/vector/changelog.md @@ -1,3 +1,11 @@ +# Changes in version NEXT_VERSION + + * [#522](https://github.com/haskell/vector/pull/522) API using Applicatives + added: `traverse` & friends. + * [#518](https://github.com/haskell/vector/pull/518) `UnboxViaStorable` added. + Vector constructors are reexported for `DoNotUnbox*`. + * [#531](https://github.com/haskell/vector/pull/531) `iconcatMap` added. + # Changes in version 0.13.2.0 * Strict boxed vector `Data.Vector.Strict` and `Data.Vector.Strict.Mutable` is From 36f86e3e9422733d1df6eb83396313b5d477657e Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 5 Sep 2025 11:03:01 +0300 Subject: [PATCH 11/14] Add tests --- vector/tests/Tests/Vector/Boxed.hs | 1 + vector/tests/Tests/Vector/Primitive.hs | 1 + vector/tests/Tests/Vector/Property.hs | 37 +++++++++++++++++++++++++- vector/tests/Tests/Vector/Storable.hs | 1 + vector/tests/Tests/Vector/Strict.hs | 1 + vector/tests/Tests/Vector/Unboxed.hs | 1 + vector/tests/Utilities.hs | 12 ++++++++- 7 files changed, 52 insertions(+), 2 deletions(-) diff --git a/vector/tests/Tests/Vector/Boxed.hs b/vector/tests/Tests/Vector/Boxed.hs index 2acbaa1c..b8c85e90 100644 --- a/vector/tests/Tests/Vector/Boxed.hs +++ b/vector/tests/Tests/Vector/Boxed.hs @@ -22,6 +22,7 @@ testGeneralBoxedVector dummy = concatMap ($ dummy) , testFunctorFunctions , testMonadFunctions , testApplicativeFunctions + , testTraverseFunctions , testAlternativeFunctions , testSequenceFunctions , testDataFunctions diff --git a/vector/tests/Tests/Vector/Primitive.hs b/vector/tests/Tests/Vector/Primitive.hs index 75592052..9e5e200a 100644 --- a/vector/tests/Tests/Vector/Primitive.hs +++ b/vector/tests/Tests/Vector/Primitive.hs @@ -17,6 +17,7 @@ testGeneralPrimitiveVector dummy = concatMap ($ dummy) , inline testPolymorphicFunctions , testOrdFunctions , testMonoidFunctions + , testTraverseFunctions , testDataFunctions ] diff --git a/vector/tests/Tests/Vector/Property.hs b/vector/tests/Tests/Vector/Property.hs index 135818d7..f1326850 100644 --- a/vector/tests/Tests/Vector/Property.hs +++ b/vector/tests/Tests/Vector/Property.hs @@ -15,6 +15,7 @@ module Tests.Vector.Property , testApplicativeFunctions , testAlternativeFunctions , testSequenceFunctions + , testTraverseFunctions , testBoolFunctions , testNumFunctions , testNestedVectorFunctions @@ -33,7 +34,7 @@ import Control.Monad.ST import qualified Data.Traversable as T (Traversable(..)) import Data.Orphans () import Data.Maybe -import Data.Foldable (foldrM) +import Data.Foldable (foldrM, traverse_, for_) import qualified Data.Vector.Generic as V import qualified Data.Vector.Generic.Mutable as MV import qualified Data.Vector.Fusion.Bundle as S @@ -768,6 +769,40 @@ testApplicativeFunctions _ = $(testProperties prop_applicative_appl :: [a -> a] -> P (v a -> v a) = \fs -> (Applicative.<*>) (V.fromList fs) `eq` (Applicative.<*>) fs +testTraverseFunctions + :: forall a v. ( CommonContext a v + , V.Vector v a + ) + => v a -> [TestTree] +{-# INLINE testTraverseFunctions #-} +testTraverseFunctions _ = $(testProperties + [ 'prop_generateA, 'prop_replicateA, 'prop_traverse, 'prop_itraverse, 'prop_for, 'prop_ifor, + 'prop_traverse_, 'prop_forA_, 'prop_itraverse_, 'prop_iforA_ + ]) + where + prop_traverse :: P ((a -> Writer [a] a) -> v a -> Writer [a] (v a)) + = V.traverse `eq` traverse + prop_itraverse :: P ((Int -> a -> Writer [a] a) -> v a -> Writer [a] (v a)) + = V.itraverse `eq` itraverse + prop_for :: P (v a -> (a -> Writer [a] a) -> Writer [a] (v a)) + = V.forA `eq` flip traverse + prop_ifor :: P (v a -> (Int -> a -> Writer [a] a) -> Writer [a] (v a)) + = V.iforA `eq` flip itraverse + prop_generateA :: P (Int -> (Int -> Writer [a] a) -> Writer [a] (v a)) + = (\n _ -> n < 1000) ===> V.generateA `eq` Util.generateM + prop_replicateA :: P (Int -> (Writer [a] a) -> Writer [a] (v a)) + = (\n _ -> n < 1000) ===> V.replicateA `eq` replicateM + prop_traverse_ :: P ((a -> Writer [a] a) -> v a -> Writer [a] ()) + = V.traverse_ `eq` traverse_ + prop_forA_ :: P (v a -> (a -> Writer [a] a) -> Writer [a] ()) + = V.forA_ `eq` for_ + prop_itraverse_ :: P ((Int -> a -> Writer [a] a) -> v a -> Writer [a] ()) + = V.itraverse_ `eq` itraverse_ + prop_iforA_ :: P (v a -> (Int -> a -> Writer [a] a) -> Writer [a] ()) + = V.iforA_ `eq` flip itraverse_ + + + testAlternativeFunctions :: forall a v. (CommonContext a v, Applicative.Alternative v) => v a -> [TestTree] {-# INLINE testAlternativeFunctions #-} testAlternativeFunctions _ = $(testProperties diff --git a/vector/tests/Tests/Vector/Storable.hs b/vector/tests/Tests/Vector/Storable.hs index 306526eb..5116c870 100644 --- a/vector/tests/Tests/Vector/Storable.hs +++ b/vector/tests/Tests/Vector/Storable.hs @@ -17,6 +17,7 @@ testGeneralStorableVector dummy = concatMap ($ dummy) , inline testPolymorphicFunctions , testOrdFunctions , testMonoidFunctions + , testTraverseFunctions , testDataFunctions ] diff --git a/vector/tests/Tests/Vector/Strict.hs b/vector/tests/Tests/Vector/Strict.hs index b041f5ae..9ad21079 100644 --- a/vector/tests/Tests/Vector/Strict.hs +++ b/vector/tests/Tests/Vector/Strict.hs @@ -22,6 +22,7 @@ testGeneralBoxedVector dummy = concatMap ($ dummy) , testFunctorFunctions , testMonadFunctions , testApplicativeFunctions + , testTraverseFunctions , testAlternativeFunctions , testSequenceFunctions , testDataFunctions diff --git a/vector/tests/Tests/Vector/Unboxed.hs b/vector/tests/Tests/Vector/Unboxed.hs index 9311b422..9fcadd86 100644 --- a/vector/tests/Tests/Vector/Unboxed.hs +++ b/vector/tests/Tests/Vector/Unboxed.hs @@ -17,6 +17,7 @@ testGeneralUnboxedVector dummy = concatMap ($ dummy) , testOrdFunctions , testTuplyFunctions , testMonoidFunctions + , testTraverseFunctions , testDataFunctions ] diff --git a/vector/tests/Utilities.hs b/vector/tests/Utilities.hs index 77e2be86..3c88926c 100644 --- a/vector/tests/Utilities.hs +++ b/vector/tests/Utilities.hs @@ -266,7 +266,11 @@ xs // ps = go xs ps' 0 go [] _ _ = [] -withIndexFirst m f = m (uncurry f) . zip [0..] +-- withIndexFirst :: (Int -> a -> [a]) -> [a] -> [a] + +withIndexFirst :: (((Int, a) -> b) -> [(Int, a)] -> c) + -> ((Int -> a -> b) -> [a] -> c) +withIndexFirst m f = m (uncurry f) . zip [0::Int ..] modifyList :: [a] -> (a -> a) -> Int -> [a] modifyList xs f i = zipWith merge xs (replicate i Nothing ++ [Just f] ++ repeat Nothing) @@ -286,6 +290,12 @@ imapM = withIndexFirst mapM imapM_ :: Monad m => (Int -> a -> m b) -> [a] -> m () imapM_ = withIndexFirst mapM_ +itraverse :: Applicative m => (Int -> a -> m a) -> [a] -> m [a] +itraverse = withIndexFirst traverse + +itraverse_ :: Applicative m => (Int -> a -> m a) -> [a] -> m () +itraverse_ = withIndexFirst traverse_ + iconcatMap :: (Int -> a -> [a]) -> [a] -> [a] iconcatMap f = concat . withIndexFirst map f From 341c230602c02bc0aecd0e571e6c8e41acc23569 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 5 Sep 2025 11:23:36 +0300 Subject: [PATCH 12/14] Fix handling of negative sizes for generateA Now it works in the same way as generateM --- vector/src/Data/Vector/Generic.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/vector/src/Data/Vector/Generic.hs b/vector/src/Data/Vector/Generic.hs index 6b1e5f31..b9957615 100644 --- a/vector/src/Data/Vector/Generic.hs +++ b/vector/src/Data/Vector/Generic.hs @@ -2682,8 +2682,9 @@ runSTA !sz = \(STA fun) -> runST $ do -- @since NEXT_VERSION generateA :: (Applicative f, Vector v a) => Int -> (Int -> f a) -> f (v a) {-# INLINE[1] generateA #-} -generateA 0 _ = pure empty -generateA n f = runSTA n <$> go 0 +generateA n f + | n <= 0 = pure empty + | otherwise = runSTA n <$> go 0 where go !i | i >= n = pure $ STA $ \_ -> pure () | otherwise = (\a (STA m) -> STA $ \mv -> M.unsafeWrite mv i a >> m mv) From cc5725f74fc05d0ab62d82774e6bc66344efd145 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Fri, 5 Sep 2025 11:36:09 +0300 Subject: [PATCH 13/14] Use liftA2 It may perform better for some applicatives --- vector/src/Data/Vector/Generic.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/vector/src/Data/Vector/Generic.hs b/vector/src/Data/Vector/Generic.hs index b9957615..9afcfc46 100644 --- a/vector/src/Data/Vector/Generic.hs +++ b/vector/src/Data/Vector/Generic.hs @@ -183,6 +183,7 @@ module Data.Vector.Generic ( gfoldl, gunfold, dataCast, mkVecType, mkVecConstr, mkType ) where +import Control.Applicative (Applicative(..), liftA2) import Data.Vector.Generic.Base import qualified Data.Vector.Generic.Mutable as M @@ -203,7 +204,7 @@ import Control.Monad.ST ( ST, runST ) import Control.Monad.Primitive import Data.Functor.Identity (Identity(..)) import Prelude - ( Eq(..), Ord(..), Num, Enum, Monoid, Applicative(..), Monad, Read, Show, Bool, Ordering(..) + ( Eq(..), Ord(..), Num, Enum, Monoid, Monad, Read, Show, Bool, Ordering(..) , Int, Maybe(..), Either, IO, ShowS, ReadS, String , compare, mempty, mappend, return, fmap, otherwise, id, flip, seq, error, undefined, uncurry, shows, fst, snd, min, max, not , (>>=), (+), (-), (*), (.), ($), (=<<), (>>), (<$>)) @@ -2687,9 +2688,10 @@ generateA n f | otherwise = runSTA n <$> go 0 where go !i | i >= n = pure $ STA $ \_ -> pure () - | otherwise = (\a (STA m) -> STA $ \mv -> M.unsafeWrite mv i a >> m mv) - <$> f i - <*> go (i + 1) + | otherwise = liftA2 + (\a (STA m) -> STA $ \mv -> M.unsafeWrite mv i a >> m mv) + (f i) + (go (i + 1)) unsafeGeneratePrim :: (PrimMonad m, Vector v a) => Int -> (Int -> m a) -> m (v a) {-# INLINE unsafeGeneratePrim #-} From e1d268878c8c6bfe0a9b0526cc95254521a8c33e Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Mon, 8 Sep 2025 12:39:24 +0300 Subject: [PATCH 14/14] Use new traverse for Traversable instances --- vector/src/Data/Vector.hs | 7 +------ vector/src/Data/Vector/Strict.hs | 7 +------ 2 files changed, 2 insertions(+), 12 deletions(-) diff --git a/vector/src/Data/Vector.hs b/vector/src/Data/Vector.hs index cc7112d9..92f10926 100644 --- a/vector/src/Data/Vector.hs +++ b/vector/src/Data/Vector.hs @@ -458,12 +458,7 @@ instance Foldable.Foldable Vector where instance Traversable.Traversable Vector where {-# INLINE traverse #-} - traverse f xs = - -- Get the length of the vector in /O(1)/ time - let !n = G.length xs - -- Use fromListN to be more efficient in construction of resulting vector - -- Also behaves better with compact regions, preventing runtime exceptions - in Data.Vector.fromListN n Applicative.<$> Traversable.traverse f (toList xs) + traverse = traverse {-# INLINE mapM #-} mapM = mapM diff --git a/vector/src/Data/Vector/Strict.hs b/vector/src/Data/Vector/Strict.hs index ece68780..4eef843a 100644 --- a/vector/src/Data/Vector/Strict.hs +++ b/vector/src/Data/Vector/Strict.hs @@ -402,12 +402,7 @@ instance Applicative.Alternative Vector where instance Traversable.Traversable Vector where {-# INLINE traverse #-} - traverse f xs = - -- Get the length of the vector in /O(1)/ time - let !n = G.length xs - -- Use fromListN to be more efficient in construction of resulting vector - -- Also behaves better with compact regions, preventing runtime exceptions - in Data.Vector.Strict.fromListN n Applicative.<$> Traversable.traverse f (toList xs) + traverse = traverse {-# INLINE mapM #-} mapM = mapM