Unboxing valore in box nel vettore di quattro tuple

Question

C'è un problema di prestazioni che sto cercando di eseguire il debug come parte di un codice più complicato. Sembra che la funzione append che sto usando per creare un vettore dinamico e espandibile di (Int,Int,Int,Int) stia causando uno dei Int nella tupla da inserire in una scatola e in unbox prima di essere scritto nel vettore. Ho scritto un codice più semplice che riproduce il problema - sembra accadere solo quando aggiungo la funzionalità di crescita vettoriale nella funzione append - codice di esempio sotto (non fa molto lavoro utile tranne la riproduzione del problema), seguito da frammenti di core che mostrare il valore di essere inscatolato e unboxed:

{-# 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 genera una versione di append per l'uso in gridWalk. Tale funzione è $wa nel nucleo - Si prega di notare l'argomento Int boxed:

$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 scatole del valore al momento della chiamata 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` ...) 
    } 
    } 
    } 
    } 
    } 

Quindi, l'effetto sembra essere la boxe di valore in gridWalk e unboxing in append prima dell'inserimento nel vettore di (Int,Int,Int,Int). La marcatura appendINLINE non modifica il comportamento: quei valori in scatola si spostano semplicemente nel corpo della funzione di gridWalk.

Apprezzerò i suggerimenti su come rendere questo valore unboxed. Mi piacerebbe mantenere la funzionalità di append (ad esempio, gestire la crescita del vettore quando viene superata la capacità) durante il refactoring.

GHC versione è 7.6.1. La versione vettoriale è 0.10.

Answer 1

Questo è solo un commento. Ho pensato che sarebbe sbarazzarsi dell'argomento tupla (regolando l'uso di append in gridWalk), ma il risultato è che (solo) l'ultimo argomento Int deve essere bang'd per ottenere tutto unboxed, che non sembra strano:

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 

---

Modifica, anche, si ottiene tutto quello che unboxed se si sposta l'applicazione del S (i+1) al di fuori del blocco di fare, ma non sono sicuro se che ci si avvicina alla cava ...:

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)  

Ma se liftM è sostituire d da fmap siamo di nuovo al unboxed solitario in cose vanno bene se liftM (S (1+i)ofmap (S (i+1) viene spostato tutta la strada verso la parte anteriore:.

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