From a60a1b2dedecba8927cc1bcf0848c6c360b92f7c Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Mon, 11 Mar 2024 19:58:12 +0000 Subject: [PATCH 1/4] Hint to GHC that indices are to be used strictly 'basicUnsafe{Read/Write/IndexM}' are class members and, unless a call site was already specialised to a specific vector instance, GHC has no clue that the index is most certainly to be used eagerly. Bang before the index provides this vital for optimizer information. --- vector/src/Data/Vector/Generic.hs | 23 ++++++++++++++--------- vector/src/Data/Vector/Generic/Mutable.hs | 12 ++++++++---- 2 files changed, 22 insertions(+), 13 deletions(-) diff --git a/vector/src/Data/Vector/Generic.hs b/vector/src/Data/Vector/Generic.hs index ec847c20..50eac299 100644 --- a/vector/src/Data/Vector/Generic.hs +++ b/vector/src/Data/Vector/Generic.hs @@ -232,15 +232,20 @@ infixl 9 ! -- | O(1) Indexing. (!) :: (HasCallStack, Vector v a) => v a -> Int -> a {-# INLINE_FUSED (!) #-} -(!) v i = checkIndex Bounds i (length v) $ unBox (basicUnsafeIndexM v i) +(!) v !i = checkIndex Bounds i (length v) $ unBox (basicUnsafeIndexM v i) +-- Why do we need ! before i? +-- The reason is that 'basicUnsafeIndexM' is a class member and, unless (!) was +-- already specialised to a specific v, GHC has no clue that i is most certainly +-- to be used eagerly. Bang before i hints this vital for optimizer information. infixl 9 !? -- | O(1) Safe indexing. (!?) :: Vector v a => v a -> Int -> Maybe a {-# INLINE_FUSED (!?) #-} -- Use basicUnsafeIndexM @Box to perform the indexing eagerly. -v !? i | i `inRange` length v = case basicUnsafeIndexM v i of Box a -> Just a - | otherwise = Nothing +v !? (!i) + | i `inRange` length v = case basicUnsafeIndexM v i of Box a -> Just a + | otherwise = Nothing -- | /O(1)/ First element. @@ -256,7 +261,7 @@ 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 = checkIndex Unsafe i (length v) $ unBox (basicUnsafeIndexM v i) +unsafeIndex v !i = checkIndex Unsafe i (length v) $ unBox (basicUnsafeIndexM v i) -- | /O(1)/ First element, without checking if the vector is empty. unsafeHead :: Vector v a => v a -> a @@ -316,7 +321,7 @@ unsafeLast v = unsafeIndex v (length v - 1) -- element) is evaluated eagerly. indexM :: (HasCallStack, Vector v a, Monad m) => v a -> Int -> m a {-# INLINE_FUSED indexM #-} -indexM v i = checkIndex Bounds i (length v) $ liftBox $ basicUnsafeIndexM v i +indexM v !i = checkIndex Bounds i (length v) $ liftBox $ basicUnsafeIndexM v i -- | /O(1)/ First element of a vector in a monad. See 'indexM' for an -- explanation of why this is useful. @@ -334,7 +339,7 @@ lastM v = indexM v (length v - 1) -- explanation of why this is useful. unsafeIndexM :: (Vector v a, Monad m) => v a -> Int -> m a {-# INLINE_FUSED unsafeIndexM #-} -unsafeIndexM v i = checkIndex Unsafe i (length v) +unsafeIndexM v !i = checkIndex Unsafe i (length v) $ liftBox $ basicUnsafeIndexM v i @@ -993,7 +998,7 @@ backpermute v is = seq v -- NOTE: we do it this way to avoid triggering LiberateCase on n in -- polymorphic code index :: HasCallStack => Int -> Box a - index i = checkIndex Bounds i n $ basicUnsafeIndexM v i + index !i = checkIndex Bounds 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 @@ -1010,7 +1015,7 @@ unsafeBackpermute v is = seq v {-# INLINE index #-} -- NOTE: we do it this way to avoid triggering LiberateCase on n in -- polymorphic code - index i = checkIndex Unsafe i n $ basicUnsafeIndexM v i + index !i = checkIndex Unsafe i n $ basicUnsafeIndexM v i -- Safe destructive updates -- ------------------------ @@ -2534,7 +2539,7 @@ streamR v = v `seq` n `seq` (Bundle.unfoldr get n `Bundle.sized` Exact n) {-# INLINE get #-} get 0 = Nothing - get i = let i' = i-1 + get i = let !i' = i-1 in case basicUnsafeIndexM v i' of Box x -> Just (x, i') diff --git a/vector/src/Data/Vector/Generic/Mutable.hs b/vector/src/Data/Vector/Generic/Mutable.hs index 67e660b7..846c2ae7 100644 --- a/vector/src/Data/Vector/Generic/Mutable.hs +++ b/vector/src/Data/Vector/Generic/Mutable.hs @@ -700,21 +700,25 @@ exchange v i x = checkIndex Bounds 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 = checkIndex Unsafe i (length v) +unsafeRead v !i = checkIndex Unsafe i (length v) $ stToPrim $ basicUnsafeRead v i +-- Why do we need ! before i? +-- The reason is that 'basicUnsafeRead' is a class member and, unless 'unsafeRead' was +-- already specialised to a specific v, GHC has no clue that i is most certainly +-- to be used eagerly. Bang before i hints this vital for optimizer information. -- | 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 = checkIndex Unsafe i (length v) +unsafeWrite v !i x = checkIndex Unsafe i (length v) $ stToPrim $ 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 = checkIndex Unsafe i (length v) +unsafeModify v f !i = checkIndex Unsafe i (length v) $ stToPrim $ basicUnsafeRead v i >>= \x -> basicUnsafeWrite v i (f x) @@ -725,7 +729,7 @@ unsafeModify v f i = checkIndex Unsafe i (length v) -- @since 0.12.3.0 unsafeModifyM :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (a -> m a) -> Int -> m () {-# INLINE unsafeModifyM #-} -unsafeModifyM v f i = checkIndex Unsafe i (length v) +unsafeModifyM v f !i = checkIndex Unsafe i (length v) $ stToPrim . basicUnsafeWrite v i =<< f =<< stToPrim (basicUnsafeRead v i) -- | Swap the elements at the given positions. No bounds checks are performed. From c43104f14b1c3ad7c986465f20ebd1ba273ac78a Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Mon, 18 Mar 2024 21:00:36 +0300 Subject: [PATCH 2/4] Apply same treatment to unsafeSlice --- vector/src/Data/Vector/Generic.hs | 2 +- vector/src/Data/Vector/Generic/Mutable.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/vector/src/Data/Vector/Generic.hs b/vector/src/Data/Vector/Generic.hs index 50eac299..46837b76 100644 --- a/vector/src/Data/Vector/Generic.hs +++ b/vector/src/Data/Vector/Generic.hs @@ -457,7 +457,7 @@ unsafeSlice :: Vector v a => Int -- ^ @i@ starting index -> v a -> v a {-# INLINE_FUSED unsafeSlice #-} -unsafeSlice i n v = checkSlice Unsafe i n (length v) $ basicUnsafeSlice i n v +unsafeSlice !i !n v = checkSlice Unsafe 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. diff --git a/vector/src/Data/Vector/Generic/Mutable.hs b/vector/src/Data/Vector/Generic/Mutable.hs index 846c2ae7..06d19406 100644 --- a/vector/src/Data/Vector/Generic/Mutable.hs +++ b/vector/src/Data/Vector/Generic/Mutable.hs @@ -425,8 +425,8 @@ unsafeSlice :: MVector v a => Int -- ^ starting index -> v s a -> v s a {-# INLINE unsafeSlice #-} -unsafeSlice i n v = checkSlice Unsafe i n (length v) - $ basicUnsafeSlice i n v +unsafeSlice !i !n v = checkSlice Unsafe i n (length v) + $ basicUnsafeSlice i n v -- | Same as 'init', but doesn't do range checks. unsafeInit :: MVector v a => v s a -> v s a From 6f2f10b96e01f8d83c054058b19ac9d928819856 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Mon, 18 Mar 2024 21:01:52 +0300 Subject: [PATCH 3/4] Indentation --- vector/src/Data/Vector/Generic/Mutable.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/vector/src/Data/Vector/Generic/Mutable.hs b/vector/src/Data/Vector/Generic/Mutable.hs index 06d19406..afaff33e 100644 --- a/vector/src/Data/Vector/Generic/Mutable.hs +++ b/vector/src/Data/Vector/Generic/Mutable.hs @@ -701,8 +701,8 @@ exchange v i x = checkIndex Bounds i (length v) $ unsafeExchange v i x unsafeRead :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a {-# INLINE unsafeRead #-} unsafeRead v !i = checkIndex Unsafe i (length v) - $ stToPrim - $ basicUnsafeRead v i + $ stToPrim + $ basicUnsafeRead v i -- Why do we need ! before i? -- The reason is that 'basicUnsafeRead' is a class member and, unless 'unsafeRead' was -- already specialised to a specific v, GHC has no clue that i is most certainly @@ -712,16 +712,16 @@ unsafeRead v !i = checkIndex Unsafe i (length v) unsafeWrite :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m () {-# INLINE unsafeWrite #-} unsafeWrite v !i x = checkIndex Unsafe i (length v) - $ stToPrim - $ basicUnsafeWrite v i x + $ stToPrim + $ 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 = checkIndex Unsafe i (length v) - $ stToPrim - $ basicUnsafeRead v i >>= \x -> - basicUnsafeWrite v i (f x) + $ stToPrim + $ basicUnsafeRead v i >>= \x -> + basicUnsafeWrite v i (f x) -- | Modify the element at the given position using a monadic -- function. No bounds checks are performed. @@ -730,7 +730,7 @@ unsafeModify v f !i = checkIndex Unsafe i (length v) unsafeModifyM :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (a -> m a) -> Int -> m () {-# INLINE unsafeModifyM #-} unsafeModifyM v f !i = checkIndex Unsafe i (length v) - $ stToPrim . basicUnsafeWrite v i =<< f =<< stToPrim (basicUnsafeRead v i) + $ stToPrim . basicUnsafeWrite v i =<< f =<< stToPrim (basicUnsafeRead v i) -- | 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 () From e13cb00644ab296c4b3d00f49468722499e34739 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Mon, 18 Mar 2024 21:13:32 +0300 Subject: [PATCH 4/4] Add NOTE like one used by GHC We have longish comment which is referenced from multiple places in source code. GHC notes seems good option for that --- vector/src/Data/Vector/Generic.hs | 21 +++++++++++++++++---- vector/src/Data/Vector/Generic/Mutable.hs | 9 +++++---- 2 files changed, 22 insertions(+), 8 deletions(-) diff --git a/vector/src/Data/Vector/Generic.hs b/vector/src/Data/Vector/Generic.hs index 46837b76..37380007 100644 --- a/vector/src/Data/Vector/Generic.hs +++ b/vector/src/Data/Vector/Generic.hs @@ -228,20 +228,31 @@ null = Bundle.null . stream -- Indexing -- -------- +-- NOTE: [Strict indexing] +-- ~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Why index parameters are strict in indexing ((!), (!?)) functions +-- and functions for accessing elements in mutable arrays ('unsafeRead', +-- 'unsafeWrite', 'unsafeModify'), and slice functions? +-- +-- These function call class methods ('basicUnsafeIndexM', +-- 'basicUnsafeRead', etc) and, unless (!) was already specialised to +-- a specific v, GHC has no clue that i is most certainly to be used +-- eagerly. Bang before i hints this vital for optimizer information. + + infixl 9 ! -- | O(1) Indexing. (!) :: (HasCallStack, Vector v a) => v a -> Int -> a {-# INLINE_FUSED (!) #-} +-- See NOTE: [Strict indexing] (!) v !i = checkIndex Bounds i (length v) $ unBox (basicUnsafeIndexM v i) --- Why do we need ! before i? --- The reason is that 'basicUnsafeIndexM' is a class member and, unless (!) was --- already specialised to a specific v, GHC has no clue that i is most certainly --- to be used eagerly. Bang before i hints this vital for optimizer information. infixl 9 !? -- | O(1) Safe indexing. (!?) :: Vector v a => v a -> Int -> Maybe a {-# INLINE_FUSED (!?) #-} +-- See NOTE: [Strict indexing] -- Use basicUnsafeIndexM @Box to perform the indexing eagerly. v !? (!i) | i `inRange` length v = case basicUnsafeIndexM v i of Box a -> Just a @@ -261,6 +272,7 @@ last v = v ! (length v - 1) -- | /O(1)/ Unsafe indexing without bounds checking. unsafeIndex :: Vector v a => v a -> Int -> a {-# INLINE_FUSED unsafeIndex #-} +-- See NOTE: [Strict indexing] unsafeIndex v !i = checkIndex Unsafe i (length v) $ unBox (basicUnsafeIndexM v i) -- | /O(1)/ First element, without checking if the vector is empty. @@ -457,6 +469,7 @@ unsafeSlice :: Vector v a => Int -- ^ @i@ starting index -> v a -> v a {-# INLINE_FUSED unsafeSlice #-} +-- See NOTE: [Strict indexing] unsafeSlice !i !n v = checkSlice Unsafe i n (length v) $ basicUnsafeSlice i n v -- | /O(1)/ Yield all but the last element without copying. The vector may not diff --git a/vector/src/Data/Vector/Generic/Mutable.hs b/vector/src/Data/Vector/Generic/Mutable.hs index afaff33e..71a8a185 100644 --- a/vector/src/Data/Vector/Generic/Mutable.hs +++ b/vector/src/Data/Vector/Generic/Mutable.hs @@ -425,6 +425,7 @@ unsafeSlice :: MVector v a => Int -- ^ starting index -> v s a -> v s a {-# INLINE unsafeSlice #-} +-- See NOTE: [Strict indexing] in D.V.Generic unsafeSlice !i !n v = checkSlice Unsafe i n (length v) $ basicUnsafeSlice i n v @@ -700,17 +701,15 @@ exchange v i x = checkIndex Bounds 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 #-} +-- See NOTE: [Strict indexing] in D.V.Generic unsafeRead v !i = checkIndex Unsafe i (length v) $ stToPrim $ basicUnsafeRead v i --- Why do we need ! before i? --- The reason is that 'basicUnsafeRead' is a class member and, unless 'unsafeRead' was --- already specialised to a specific v, GHC has no clue that i is most certainly --- to be used eagerly. Bang before i hints this vital for optimizer information. -- | 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 #-} +-- See NOTE: [Strict indexing] in D.V.Generic unsafeWrite v !i x = checkIndex Unsafe i (length v) $ stToPrim $ basicUnsafeWrite v i x @@ -718,6 +717,7 @@ unsafeWrite v !i x = checkIndex Unsafe i (length v) -- | 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 #-} +-- See NOTE: [Strict indexing] in D.V.Generic unsafeModify v f !i = checkIndex Unsafe i (length v) $ stToPrim $ basicUnsafeRead v i >>= \x -> @@ -729,6 +729,7 @@ unsafeModify v f !i = checkIndex Unsafe i (length v) -- @since 0.12.3.0 unsafeModifyM :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (a -> m a) -> Int -> m () {-# INLINE unsafeModifyM #-} +-- See NOTE: [Strict indexing] in D.V.Generic unsafeModifyM v f !i = checkIndex Unsafe i (length v) $ stToPrim . basicUnsafeWrite v i =<< f =<< stToPrim (basicUnsafeRead v i)