performance - 拆箱四元组向量中的装箱值

Question

我正在尝试将一个性能问题作为更复杂代码的一部分进行调试。看来append我用来创建 (Int,Int,Int,Int) 的动态、可增长向量的函数正在引起 Int 之一在写入向量之前要装箱和拆箱的元组中。我写了一个更简单的代码来重现这个问题——似乎只有当我在 append 中添加向量增长功能时才会发生这种情况。函数 - 下面的示例代码(除了重现问题外，它没有做太多有用的工作)，后面是 core 的片段显示装箱和拆箱的值:

{-# LANGUAGE BangPatterns #-}
module Test
where
import Data.Vector.Unboxed.Mutable as MU
import Data.Vector.Unboxed as U hiding (mapM_)
import Control.Monad.ST as ST
import Control.Monad.Primitive (PrimState)
import Control.Monad (when)
import GHC.Float.RealFracMethods (int2Float)
import Data.STRef (newSTRef, writeSTRef, readSTRef)
import Data.Word

type MVI1 s  = MVector (PrimState (ST s)) Int
type MVI4 s  = MVector (PrimState (ST s)) (Int,Int,Int,Int)
data Snakev s = S {-# UNPACK #-}!Int
                                !(MVI4 s)

newVI1 :: Int -> Int -> ST s (MVI1 s)
newVI1 n x = do
          a <- new n
          mapM_ (\i -> MU.unsafeWrite a i x) [0..n-1]
          return a

-- Growable array - we always append an element. It grows by factor of 1.5 if more capacity is needed
append :: Snakev s -> (Int,Int,Int,Int) -> ST s (Snakev s)
append (S i v) x = do
   if i < MU.length v then MU.unsafeWrite v i x >> return (S (i+1) v)
   else MU.unsafeGrow v (floor $! 1.5 * (int2Float $ MU.length v)) >>= (\y -> MU.unsafeWrite y i x >> return (S (i+1) y))

gridWalk :: Vector Word8 -> Vector Word8 -> MVI1 s -> MVI1 s -> Snakev s -> Int -> (Vector Word8 -> Vector Word8 -> Int -> Int ->      Int) -> ST s (Snakev s)
gridWalk a b fp snodes snakesv !k cmp = do
   let offset = 1+U.length a
       xp = offset-k
   snodep <- MU.unsafeRead snodes xp -- get the index of previous snake node in snakev array
   append snakesv (snodep,xp,xp,xp)
{-#INLINABLE gridWalk #-}

GHC 生成版本 append用于 gridWalk .该函数是 $wa在核心中 - 请注意盒装的 Int 参数:

$wa
  :: forall s.
     Int#
     -> MVI4 s
     -> Int#
     -> Int#
     -> Int#
     -> Int  ======= Boxed value - one of (Int,Int,Int,Int) is boxed
     -> State# s
     -> (# State# s, Snakev s #)
$wa =
  \ (@ s)
    (ww :: Int#)
    (ww1 :: MVI4 s)
    (ww2 :: Int#)
    (ww3 :: Int#)
    (ww4 :: Int#)
    (ww5 :: Int) === Boxed value
    (w :: State# s) ->

....
....
of ipv12 { __DEFAULT ->
              case (writeIntArray# ipv7 ww ww4 (ipv12 `cast` ...)) `cast` ...
              of ipv13 { __DEFAULT ->
              (# case ww5 of _ { I# x# ->
                 (writeIntArray# ipv10 ww x# (ipv13 `cast` ...)) `cast` ...
                 },
                 S (+# ww 1)
                   ((MV_4
                       (+# y rb)
                       ==== x below unboxed from arg ww5 ======
                       ((MVector 0 x ipv1) `cast` ...) 
                       ((MVector 0 x1 ipv4) `cast` ...)
                       ((MVector 0 x2 ipv7) `cast` ...)
                       ((MVector 0 x3 ipv10) `cast` ...))
                    `cast` ...) #)

gridWalk调用时将值框起来 append :

=== function called by gridWalk ======
a :: forall s.
     Vector Word8
     -> Vector Word8
     -> MVI1 s
     -> MVI1 s
     -> Snakev s
     -> Int
     -> (Vector Word8 -> Vector Word8 -> Int -> Int -> Int)
     -> State# s
     -> (# State# s, Snakev s #)
a =
  \ (@ s)
    (a1 :: Vector Word8)
    _
    _
    (snodes :: MVI1 s)
    (snakesv :: Snakev s)
    (k :: Int)
    _
    (eta :: State# s) ->
    case k of _ { I# ipv ->
    case snodes `cast` ... of _ { MVector rb _ rb2 ->
    case a1 `cast` ... of _ { Vector _ rb4 _ ->
    let {
      y :: Int#
      y = -# (+# 1 rb4) ipv } in
    case readIntArray# rb2 (+# rb y) (eta `cast` ...)
    of _ { (# ipv1, ipv2 #) ->
    case snakesv of _ { S ww ww1 ->
    ====== y boxed below before append called ======
    $wa ww ww1 ipv2 y y (I# y) (ipv1 `cast` ...) 
    }
    }
    }
    }
    }

因此，效果似乎是 gridWalk 中的值的装箱并在 append 中拆箱在插入 (Int,Int,Int,Int) 的向量之前.标记 append INLINE不会改变行为——那些装箱的值只是在 gridWalk 的函数体中移动.

我将感谢有关如何取消装箱此值的指示。我想保留 append 的功能(即，在超出容量时处理向量增长)同时重构它。
GHC版本是 7.6.1 .矢量版是 0.10 .

Answer 1

这只是一个评论。我想我会摆脱元组参数(在 append 中调整 gridWalk 的使用)，但结果是(仅)最后一个 Int 参数必须被 bang'd 来取消装箱，这似乎奇怪的:

append :: Snakev s -> Int -> Int -> Int -> Int -> ST s (Snakev s)
append (S i v) a b c !d = do
   if i < len then do MU.unsafeWrite v i (a,b,c,d)
                      return $ S (i+1) v
              else do y <- MU.unsafeGrow v additional        
                      MU.unsafeWrite y i (a,b,c,d) 
                      return $ S (i+1) y
  where len = MU.length v           
        additional = floor (1.5 * int2Float len) -- this seems kind of bizarre 
                                        -- by the way; can't you stay inside Int?
                                        --  3 * (len `div` 2) or something

编辑，此外，如果您移动 S (i+1) 的应用程序，您可以将所有内容拆箱。在 do 块外面，但我不确定这是否能让我们更接近采石场......:

append :: Snakev s -> Int -> Int -> Int -> Int -> ST s (Snakev s)
append (S i v) a b c d = do
       if i < len then liftM (S (i+1)) $ do MU.unsafeWrite v i (a,b,c,d)
                                            return v
                  else liftM ( S (i+1)) $ do y <- MU.unsafeGrow v zzz         
                                             MU.unsafeWrite y i (a,b,c,d) 
                                             return  y
      where len = MU.length v           
            zzz = floor (1.5 * int2Float len)     

但如果 liftM被 fmap 取代我们回到了唯一的未装箱状态。如果 liftM (S (1+i) 一切顺利或 fmap (S (i+1)一直移到前面:

append (S i v) a b c d = S (i+1) <$> do ...