Odblokowanie wartości pudełkowej w wektorze czterech krotek

Question

Występuje problem z wydajnością, który próbuję usunąć, jako część bardziej skomplikowanego kodu. Wygląda na to, że funkcja append, której używam do utworzenia dynamicznego, nadającego się do gry wektora (Int,Int,Int,Int), powoduje, że jeden z Int w krotce jest zapakowany w pudełka i rozpakowany przed zapisaniem w wektorze. Napisałem prostszy kod, który odtwarza problem - zdaje się, że dzieje się tak tylko wtedy, gdy dodaję funkcję wzrostu wektorów w funkcji append - przykładowy kod poniżej (nie przynosi to wiele użytecznych prac poza odtworzeniem problemu), a następnie fragmenty z core, które pokazać wartość jest zapakowane i rozpakowanych:

{-# 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 generuje wersję append do użytku w gridWalk. Że funkcja jest $wa w rdzeniu - Proszę zwrócić uwagę na pudełkową Int argument:

$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 pola Wartość Dzwoniąc 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` ...) 
    } 
    } 
    } 
    } 
    } 

Tak, efekt wydaje się być boks wartości w gridWalk i rozpakowywanie w append przed wstawieniem do wektora (Int,Int,Int,Int). Oznaczanie appendINLINE nie zmienia zachowania - te wartości w ramkach po prostu poruszają się w treści funkcji gridWalk.

Doceniam wskazówki, jak wprowadzić tę wartość do rozpakowania. Chciałbym zachować funkcjonalność append (tj. Obsłużyć wzrost wektora po przekroczeniu pojemności) podczas jego refaktoryzacji.

GHC wersja to 7.6.1. Wersja wektorowa to 0.10.

Answer 1

To tylko komentarz. Pomyślałem, że pozbyłbym się argumentu krotki (dostosowując użycie append w gridWalk), ale wynikiem jest to, że (tylko) ostatni argument Int musi zostać pobudzony, aby wszystko zostało rozpakowane, co wydaje się dziwne:

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 

---

Edycja też, masz wszystko bez opakowania po przeniesieniu stosowania S (i+1) poza blokiem zrobić, ale nie jestem pewien, czy to dostaje nam bliżej do kamieniołomu ...:

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)  

Ale jeśli liftM jest zastąpić d przez fmap jesteśmy z powrotem do samotny unboxed w sprawy idą dobrze, jeśli liftM (S (1+i)lubfmap (S (i+1) jest przesuwana przez całą drogę się do przodu.

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