From 4b682ae6ec6c0395c1cda38a5c05acb1b0748499 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Sat, 23 Mar 2024 00:41:40 +0000 Subject: [PATCH 1/2] Introduce basicUnsafeIndexM# --- vector/internal/GenUnboxTuple.hs | 7 +- vector/internal/unbox-tuple-instances | 64 +++++++++---------- vector/src/Data/Vector.hs | 7 +- .../src/Data/Vector/Fusion/Bundle/Monadic.hs | 28 ++++---- vector/src/Data/Vector/Generic.hs | 26 ++++---- vector/src/Data/Vector/Generic/Base.hs | 23 +++++-- vector/src/Data/Vector/Primitive.hs | 5 +- vector/src/Data/Vector/Storable.hs | 7 +- vector/src/Data/Vector/Unboxed.hs | 1 + vector/src/Data/Vector/Unboxed/Base.hs | 34 +++++----- 10 files changed, 114 insertions(+), 88 deletions(-) diff --git a/vector/internal/GenUnboxTuple.hs b/vector/internal/GenUnboxTuple.hs index 64daafa5..eed092c4 100644 --- a/vector/internal/GenUnboxTuple.hs +++ b/vector/internal/GenUnboxTuple.hs @@ -1,7 +1,12 @@ +#!/usr/bin/env cabal +{- cabal: +build-depends: base, pretty +-} {-# LANGUAGE ParallelListComp #-} module Main where +import Prelude hiding ((<>)) import Text.PrettyPrint import System.Environment ( getArgs ) @@ -235,6 +240,6 @@ generate n = ,("basicUnsafeThaw", gen_unsafeThaw) ,("basicLength", gen_length "V") ,("basicUnsafeSlice", gen_unsafeSlice "G" "V") - ,("basicUnsafeIndexM", gen_basicUnsafeIndexM) + ,("basicUnsafeIndexM#", gen_basicUnsafeIndexM) ,("basicUnsafeCopy", gen_unsafeCopy "V" qG) ,("elemseq", gen_elemseq)] diff --git a/vector/internal/unbox-tuple-instances b/vector/internal/unbox-tuple-instances index 985a3b10..9ee4999b 100644 --- a/vector/internal/unbox-tuple-instances +++ b/vector/internal/unbox-tuple-instances @@ -90,11 +90,11 @@ instance (Unbox a, Unbox b) => G.Vector Vector (a, b) where basicUnsafeSlice i_ m_ (V_2 _ as bs) = V_2 m_ (G.basicUnsafeSlice i_ m_ as) (G.basicUnsafeSlice i_ m_ bs) - {-# INLINE basicUnsafeIndexM #-} - basicUnsafeIndexM (V_2 _ as bs) i_ + {-# INLINE basicUnsafeIndexM# #-} + basicUnsafeIndexM# (V_2 _ as bs) i_ = do - a <- G.basicUnsafeIndexM as i_ - b <- G.basicUnsafeIndexM bs i_ + a <- G.basicUnsafeIndexM# as i_ + b <- G.basicUnsafeIndexM# bs i_ return (a, b) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_2 _ as1 bs1) (V_2 _ as2 bs2) @@ -248,12 +248,12 @@ instance (Unbox a, = V_3 m_ (G.basicUnsafeSlice i_ m_ as) (G.basicUnsafeSlice i_ m_ bs) (G.basicUnsafeSlice i_ m_ cs) - {-# INLINE basicUnsafeIndexM #-} - basicUnsafeIndexM (V_3 _ as bs cs) i_ + {-# INLINE basicUnsafeIndexM# #-} + basicUnsafeIndexM# (V_3 _ as bs cs) i_ = do - a <- G.basicUnsafeIndexM as i_ - b <- G.basicUnsafeIndexM bs i_ - c <- G.basicUnsafeIndexM cs i_ + a <- G.basicUnsafeIndexM# as i_ + b <- G.basicUnsafeIndexM# bs i_ + c <- G.basicUnsafeIndexM# cs i_ return (a, b, c) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_3 _ as1 bs1 cs1) (V_3 _ as2 bs2 cs2) @@ -448,13 +448,13 @@ instance (Unbox a, (G.basicUnsafeSlice i_ m_ bs) (G.basicUnsafeSlice i_ m_ cs) (G.basicUnsafeSlice i_ m_ ds) - {-# INLINE basicUnsafeIndexM #-} - basicUnsafeIndexM (V_4 _ as bs cs ds) i_ + {-# INLINE basicUnsafeIndexM# #-} + basicUnsafeIndexM# (V_4 _ as bs cs ds) i_ = do - a <- G.basicUnsafeIndexM as i_ - b <- G.basicUnsafeIndexM bs i_ - c <- G.basicUnsafeIndexM cs i_ - d <- G.basicUnsafeIndexM ds i_ + a <- G.basicUnsafeIndexM# as i_ + b <- G.basicUnsafeIndexM# bs i_ + c <- G.basicUnsafeIndexM# cs i_ + d <- G.basicUnsafeIndexM# ds i_ return (a, b, c, d) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_4 _ as1 bs1 cs1 ds1) (V_4 _ as2 @@ -700,14 +700,14 @@ instance (Unbox a, (G.basicUnsafeSlice i_ m_ cs) (G.basicUnsafeSlice i_ m_ ds) (G.basicUnsafeSlice i_ m_ es) - {-# INLINE basicUnsafeIndexM #-} - basicUnsafeIndexM (V_5 _ as bs cs ds es) i_ - = do - a <- G.basicUnsafeIndexM as i_ - b <- G.basicUnsafeIndexM bs i_ - c <- G.basicUnsafeIndexM cs i_ - d <- G.basicUnsafeIndexM ds i_ - e <- G.basicUnsafeIndexM es i_ + {-# INLINE basicUnsafeIndexM# #-} + basicUnsafeIndexM# (V_5 _ as bs cs ds es) i_ + = do + a <- G.basicUnsafeIndexM# as i_ + b <- G.basicUnsafeIndexM# bs i_ + c <- G.basicUnsafeIndexM# cs i_ + d <- G.basicUnsafeIndexM# ds i_ + e <- G.basicUnsafeIndexM# es i_ return (a, b, c, d, e) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_5 _ as1 bs1 cs1 ds1 es1) (V_5 _ as2 @@ -1002,15 +1002,15 @@ instance (Unbox a, (G.basicUnsafeSlice i_ m_ ds) (G.basicUnsafeSlice i_ m_ es) (G.basicUnsafeSlice i_ m_ fs) - {-# INLINE basicUnsafeIndexM #-} - basicUnsafeIndexM (V_6 _ as bs cs ds es fs) i_ - = do - a <- G.basicUnsafeIndexM as i_ - b <- G.basicUnsafeIndexM bs i_ - c <- G.basicUnsafeIndexM cs i_ - d <- G.basicUnsafeIndexM ds i_ - e <- G.basicUnsafeIndexM es i_ - f <- G.basicUnsafeIndexM fs i_ + {-# INLINE basicUnsafeIndexM# #-} + basicUnsafeIndexM# (V_6 _ as bs cs ds es fs) i_ + = do + a <- G.basicUnsafeIndexM# as i_ + b <- G.basicUnsafeIndexM# bs i_ + c <- G.basicUnsafeIndexM# cs i_ + d <- G.basicUnsafeIndexM# ds i_ + e <- G.basicUnsafeIndexM# es i_ + f <- G.basicUnsafeIndexM# fs i_ return (a, b, c, d, e, f) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_6 _ as1 bs1 cs1 ds1 es1 fs1) (V_6 _ as2 diff --git a/vector/src/Data/Vector.hs b/vector/src/Data/Vector.hs index 5a6f89cb..39b08f01 100644 --- a/vector/src/Data/Vector.hs +++ b/vector/src/Data/Vector.hs @@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} @@ -212,7 +213,7 @@ import qualified Control.Applicative as Applicative import qualified Data.Foldable as Foldable import qualified Data.Traversable as Traversable -import qualified GHC.Exts as Exts (IsList(..)) +import qualified GHC.Exts as Exts (IsList(..), Int(..)) -- | Boxed vectors, supporting efficient slicing. @@ -278,8 +279,8 @@ instance G.Vector Vector a where {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice j n (Vector i _ arr) = Vector (i+j) n arr - {-# INLINE basicUnsafeIndexM #-} - basicUnsafeIndexM (Vector i _ arr) j = indexArrayM arr (i+j) + {-# INLINE basicUnsafeIndexM# #-} + basicUnsafeIndexM# (Vector i _ arr) j = indexArrayM arr (i + Exts.I# j) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MVector i n dst) (Vector j _ src) diff --git a/vector/src/Data/Vector/Fusion/Bundle/Monadic.hs b/vector/src/Data/Vector/Fusion/Bundle/Monadic.hs index 99a3bdea..3a899203 100644 --- a/vector/src/Data/Vector/Fusion/Bundle/Monadic.hs +++ b/vector/src/Data/Vector/Fusion/Bundle/Monadic.hs @@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -98,10 +99,10 @@ import Control.Monad.Primitive import qualified Data.List as List import Data.Char ( ord ) -import GHC.Base ( unsafeChr ) +import GHC.Base ( unsafeChr, Int(..) ) import Control.Monad ( liftM ) import Prelude - ( Eq, Ord, Num, Enum, Functor, Monad, Bool(..), Ordering, Char, Int, Word, Integer, Float, Double, Maybe(..), Either(..), Integral, RealFrac + ( Eq, Ord, Num, Enum, Functor, Monad, Bool(..), Ordering, Char, Word, Integer, Float, Double, Maybe(..), Either(..), Integral, RealFrac , return, fmap, otherwise, id, const, seq, max, maxBound, fromIntegral, truncate , (+), (-), (<), (<=), (>), (>=), (==), (/=), (&&), (.), ($), (<$), (/) ) @@ -1091,9 +1092,10 @@ fromVector v = v `seq` n `seq` Bundle (Stream step 0) n = basicLength v {-# INLINE step #-} - step i | i >= n = return Done - | otherwise = case basicUnsafeIndexM v i of - Box x -> return $ Yield x (i+1) + step (I# i) + | I# i >= n = return Done + | otherwise = case basicUnsafeIndexM# v i of + Box x -> return $ Yield x (I# i + 1) {-# INLINE vstep #-} @@ -1112,10 +1114,10 @@ fromVectors us = Bundle (Stream pstep (Left 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)) + pstep (Right (v, I# i, vs)) + | I# i >= basicLength v = return $ Skip (Left vs) + | otherwise = case basicUnsafeIndexM# v i of + Box x -> return $ Yield x (Right (v, I# i + 1, vs)) -- FIXME: work around bug in GHC 7.6.1 vstep :: HasCallStack => [v a] -> m (Step [v a] (Chunk v a)) @@ -1143,10 +1145,10 @@ concatVectors Bundle{sElems = Stream step t} 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))) + pstep (Right (v, I# i, s)) + | I# i >= basicLength v = return (Skip (Left s)) + | otherwise = case basicUnsafeIndexM# v i of + Box x -> return (Yield x (Right (v, I# i + 1,s))) vstep s = do diff --git a/vector/src/Data/Vector/Generic.hs b/vector/src/Data/Vector/Generic.hs index 37380007..0ffbb1cd 100644 --- a/vector/src/Data/Vector/Generic.hs +++ b/vector/src/Data/Vector/Generic.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -211,6 +212,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 GHC.Exts (Int(..)) -- Length information -- ------------------ @@ -246,16 +248,16 @@ infixl 9 ! (!) :: (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) +(!) v (I# i) = checkIndex Bounds (I# i) (length v) $ unBox (basicUnsafeIndexM# v i) 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 +-- Use basicUnsafeIndexM# @Box to perform the indexing eagerly. +v !? (I# i) + | I# i `inRange` length v = case basicUnsafeIndexM# v i of Box a -> Just a | otherwise = Nothing @@ -273,7 +275,7 @@ last v = v ! (length v - 1) 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) +unsafeIndex v (I# i) = checkIndex Unsafe (I# 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 @@ -333,7 +335,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# i) = checkIndex Bounds (I# 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. @@ -351,9 +353,9 @@ 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# i) = checkIndex Unsafe (I# i) (length v) $ liftBox - $ basicUnsafeIndexM v i + $ 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. @@ -1011,7 +1013,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# i) = checkIndex Bounds (I# 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 @@ -1028,7 +1030,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# i) = checkIndex Unsafe (I# i) n $ basicUnsafeIndexM# v i -- Safe destructive updates -- ------------------------ @@ -2552,9 +2554,9 @@ 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') = i-1 in - case basicUnsafeIndexM v i' of Box x -> Just (x, i') + case basicUnsafeIndexM# v i' of Box x -> Just (x, I# i') -- | /O(n)/ Construct a vector from a 'Bundle', proceeding from right to left. unstreamR :: Vector v a => Bundle v a -> v a diff --git a/vector/src/Data/Vector/Generic/Base.hs b/vector/src/Data/Vector/Generic/Base.hs index e1055f81..5eb0ef96 100644 --- a/vector/src/Data/Vector/Generic/Base.hs +++ b/vector/src/Data/Vector/Generic/Base.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -34,6 +35,7 @@ import qualified Data.Primitive.PrimArray as Prim import Control.Monad.ST import Data.Kind (Type) +import GHC.Exts (Int(..), Int#) -- | @Mutable v s a@ is the mutable version of the immutable vector type @v a@ with -- the state token @s@. It is injective on GHC 8 and newer. @@ -112,7 +114,13 @@ class MVector (Mutable v) a => Vector v a where -- -- which does not have this problem, because indexing (but not the returned -- element!) is evaluated immediately. - basicUnsafeIndexM :: v a -> Int -> Box a + basicUnsafeIndexM :: v a -> Int -> Box a + basicUnsafeIndexM xs (I# i) = basicUnsafeIndexM# xs i + {-# INLINE basicUnsafeIndexM #-} + + basicUnsafeIndexM# :: v a -> Int# -> Box a + basicUnsafeIndexM# xs i = basicUnsafeIndexM xs (I# i) + {-# INLINE basicUnsafeIndexM# #-} -- | /Assumed complexity: O(n)/ -- @@ -131,11 +139,12 @@ class MVector (Mutable v) a => Vector v a where where !n = basicLength src - do_copy i | i < n = do - x <- liftBox $ basicUnsafeIndexM src i - M.basicUnsafeWrite dst i x - do_copy (i+1) - | otherwise = return () + do_copy (I# i) + | I# i < n = do + x <- liftBox $ basicUnsafeIndexM# src i + M.basicUnsafeWrite dst (I# i) x + do_copy (I# 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. This method is @@ -152,4 +161,4 @@ class MVector (Mutable v) a => Vector v a where elemseq _ = \_ x -> x {-# MINIMAL basicUnsafeFreeze, basicUnsafeThaw, basicLength, - basicUnsafeSlice, basicUnsafeIndexM #-} + basicUnsafeSlice, (basicUnsafeIndexM | basicUnsafeIndexM#) #-} diff --git a/vector/src/Data/Vector/Primitive.hs b/vector/src/Data/Vector/Primitive.hs index 981f3abe..f50aece3 100644 --- a/vector/src/Data/Vector/Primitive.hs +++ b/vector/src/Data/Vector/Primitive.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RoleAnnotations #-} @@ -249,8 +250,8 @@ instance Prim a => G.Vector Vector a where {-# 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 basicUnsafeIndexM# #-} + basicUnsafeIndexM# (Vector i _ arr) j = return $! indexByteArray arr (i + Exts.I# j) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MVector i n dst) (Vector j _ src) diff --git a/vector/src/Data/Vector/Storable.hs b/vector/src/Data/Vector/Storable.hs index 4a052a07..8979e73c 100644 --- a/vector/src/Data/Vector/Storable.hs +++ b/vector/src/Data/Vector/Storable.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RoleAnnotations #-} @@ -257,11 +258,11 @@ instance Storable a => G.Vector Vector a where {-# INLINE basicUnsafeSlice #-} basicUnsafeSlice i n (Vector _ fp) = Vector n (updPtr (`advancePtr` i) fp) - {-# INLINE basicUnsafeIndexM #-} - basicUnsafeIndexM (Vector _ fp) i = return + {-# INLINE basicUnsafeIndexM# #-} + basicUnsafeIndexM# (Vector _ fp) i = return . unsafeInlineIO $ unsafeWithForeignPtr fp $ \p -> - peekElemOff p i + peekElemOff p (Exts.I# i) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MVector n fp) (Vector _ fq) diff --git a/vector/src/Data/Vector/Unboxed.hs b/vector/src/Data/Vector/Unboxed.hs index 0f5ed15c..dd851256 100644 --- a/vector/src/Data/Vector/Unboxed.hs +++ b/vector/src/Data/Vector/Unboxed.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} -- | diff --git a/vector/src/Data/Vector/Unboxed/Base.hs b/vector/src/Data/Vector/Unboxed/Base.hs index d1d1ad7f..53da37df 100644 --- a/vector/src/Data/Vector/Unboxed/Base.hs +++ b/vector/src/Data/Vector/Unboxed/Base.hs @@ -4,6 +4,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE StandaloneDeriving #-} @@ -161,6 +162,9 @@ instance G.Vector Vector () where {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (V_Unit _) _ = return () + {-# INLINE basicUnsafeIndexM# #-} + basicUnsafeIndexM# (V_Unit _) _ = return () + {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MV_Unit _) (V_Unit _) = return () @@ -253,13 +257,13 @@ instance P.Prim a => G.Vector Vector (UnboxViaPrim a) where {-# INLINE basicUnsafeThaw #-} {-# INLINE basicLength #-} {-# INLINE basicUnsafeSlice #-} - {-# INLINE basicUnsafeIndexM #-} + {-# INLINE basicUnsafeIndexM# #-} {-# INLINE elemseq #-} basicUnsafeFreeze = coerce $ G.basicUnsafeFreeze @P.Vector @a basicUnsafeThaw = coerce $ G.basicUnsafeThaw @P.Vector @a basicLength = coerce $ G.basicLength @P.Vector @a basicUnsafeSlice = coerce $ G.basicUnsafeSlice @P.Vector @a - basicUnsafeIndexM = coerce $ G.basicUnsafeIndexM @P.Vector @a + basicUnsafeIndexM# = coerce $ G.basicUnsafeIndexM# @P.Vector @a basicUnsafeCopy = coerce $ G.basicUnsafeCopy @P.Vector @a elemseq _ = seq @@ -393,8 +397,8 @@ instance (IsoUnbox a b, Unbox b) => G.Vector Vector (As a b) where basicUnsafeCopy = coerce $ G.basicUnsafeCopy @Vector @b elemseq _ = seq -- Conversion to/from underlying representation - {-# INLINE basicUnsafeIndexM #-} - basicUnsafeIndexM (V_UnboxAs v) i = As . fromURepr <$> G.basicUnsafeIndexM v i + {-# INLINE basicUnsafeIndexM# #-} + basicUnsafeIndexM# (V_UnboxAs v) i = As . fromURepr <$> G.basicUnsafeIndexM# v i #define primMVector(ty,con) \ @@ -431,13 +435,13 @@ instance G.Vector Vector ty where { \ ; {-# INLINE basicUnsafeThaw #-} \ ; {-# INLINE basicLength #-} \ ; {-# INLINE basicUnsafeSlice #-} \ -; {-# INLINE basicUnsafeIndexM #-} \ +; {-# 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 \ +; basicUnsafeIndexM# (con v) i = G.basicUnsafeIndexM# v i \ ; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v \ ; elemseq _ = seq } @@ -573,13 +577,13 @@ instance G.Vector Vector Bool where {-# INLINE basicUnsafeThaw #-} {-# INLINE basicLength #-} {-# INLINE basicUnsafeSlice #-} - {-# INLINE basicUnsafeIndexM #-} + {-# 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 + basicUnsafeIndexM# (V_Bool v) i = toBool `liftM` G.basicUnsafeIndexM# v i basicUnsafeCopy (MV_Bool mv) (V_Bool v) = G.basicUnsafeCopy mv v elemseq _ = seq @@ -631,10 +635,10 @@ instance (Unbox a) => G.Vector Vector (Complex a) where basicLength = coerce $ G.basicLength @Vector @(a,a) basicUnsafeSlice = coerce $ G.basicUnsafeSlice @Vector @(a,a) basicUnsafeCopy = coerce $ G.basicUnsafeCopy @Vector @(a,a) - {-# INLINE basicUnsafeIndexM #-} + {-# INLINE basicUnsafeIndexM# #-} {-# INLINE elemseq #-} - basicUnsafeIndexM (V_Complex v) i - = uncurry (:+) <$> G.basicUnsafeIndexM v i + basicUnsafeIndexM# (V_Complex v) i + = uncurry (:+) <$> G.basicUnsafeIndexM# v i elemseq _ (x :+ y) z = G.elemseq (undefined :: Vector a) x $ G.elemseq (undefined :: Vector a) y z @@ -675,13 +679,13 @@ instance inst_ctxt => G.Vector Vector (inst_head) where { \ ; {-# INLINE basicUnsafeThaw #-} \ ; {-# INLINE basicLength #-} \ ; {-# INLINE basicUnsafeSlice #-} \ -; {-# INLINE basicUnsafeIndexM #-} \ +; {-# 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 = tyC `liftM` G.basicUnsafeIndexM v i \ +; basicUnsafeIndexM# (con v) i = tyC `liftM` G.basicUnsafeIndexM# v i \ ; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v \ ; elemseq _ (tyC a) = G.elemseq (undefined :: Vector x) a \ } @@ -758,9 +762,9 @@ instance (Unbox a, Unbox b) => G.Vector Vector (Arg a b) where basicLength = coerce $ G.basicLength @Vector @(a,b) basicUnsafeSlice = coerce $ G.basicUnsafeSlice @Vector @(a,b) basicUnsafeCopy = coerce $ G.basicUnsafeCopy @Vector @(a,b) - {-# INLINE basicUnsafeIndexM #-} + {-# INLINE basicUnsafeIndexM# #-} {-# INLINE elemseq #-} - basicUnsafeIndexM (V_Arg v) i = uncurry Arg `liftM` G.basicUnsafeIndexM v i + basicUnsafeIndexM# (V_Arg v) i = uncurry Arg `liftM` G.basicUnsafeIndexM# v i elemseq _ (Arg x y) z = G.elemseq (undefined :: Vector a) x $ G.elemseq (undefined :: Vector b) y z From 7acc4aba0cb4a0e9b853644cacd6b0c13a7d353c Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Thu, 4 Apr 2024 22:35:45 +0300 Subject: [PATCH 2/2] Use coerce in definition Unbox instances wrapping primitive vector In stddev benchmark with NOINLINE it gives quite significat improvements accross all compiler versions: - 3-10% reduction on CPU cycles depending on GHC version - -2 branches/per indexing for all cases. No change for inlined version Overall this is cheap and nice change. --- vector/src/Data/Vector/Unboxed/Base.hs | 40 ++++++++++++++------------ 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/vector/src/Data/Vector/Unboxed/Base.hs b/vector/src/Data/Vector/Unboxed/Base.hs index 53da37df..d5b9f522 100644 --- a/vector/src/Data/Vector/Unboxed/Base.hs +++ b/vector/src/Data/Vector/Unboxed/Base.hs @@ -415,19 +415,19 @@ instance M.MVector MVector ty where { \ ; {-# 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 } +; basicLength = coerce (M.basicLength @P.MVector) \ +; basicUnsafeSlice = coerce (M.basicUnsafeSlice @P.MVector) \ +; basicOverlaps = coerce (M.basicOverlaps @P.MVector) \ +; basicUnsafeNew = coerce (M.basicUnsafeNew @P.MVector) \ +; basicInitialize = coerce (M.basicInitialize @P.MVector) \ +; basicUnsafeReplicate = coerce (M.basicUnsafeReplicate @P.MVector) \ +; basicUnsafeRead = coerce (M.basicUnsafeRead @P.MVector) \ +; basicUnsafeWrite = coerce (M.basicUnsafeWrite @P.MVector) \ +; basicClear = coerce (M.basicClear @P.MVector) \ +; basicSet = coerce (M.basicSet @P.MVector) \ +; basicUnsafeCopy = coerce (M.basicUnsafeCopy @P.MVector) \ +; basicUnsafeMove = coerce (M.basicUnsafeMove @P.MVector) \ +; basicUnsafeGrow = coerce (M.basicUnsafeGrow @P.MVector)} #define primVector(ty,con,mcon) \ instance G.Vector Vector ty where { \ @@ -435,14 +435,16 @@ instance G.Vector Vector ty where { \ ; {-# INLINE basicUnsafeThaw #-} \ ; {-# INLINE basicLength #-} \ ; {-# INLINE basicUnsafeSlice #-} \ +; {-# INLINE basicUnsafeIndexM #-} \ ; {-# 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 \ +; basicUnsafeFreeze = coerce (G.basicUnsafeFreeze @P.Vector) \ +; basicUnsafeThaw = coerce (G.basicUnsafeThaw @P.Vector) \ +; basicLength = coerce (G.basicLength @P.Vector) \ +; basicUnsafeSlice = coerce (G.basicUnsafeSlice @P.Vector) \ +; basicUnsafeIndexM = coerce (G.basicUnsafeIndexM @P.Vector) \ +; basicUnsafeIndexM# = coerce (G.basicUnsafeIndexM# @P.Vector) \ +; basicUnsafeCopy = coerce (G.basicUnsafeCopy @P.Vector) \ ; elemseq _ = seq } newtype instance MVector s Int = MV_Int (P.MVector s Int)