Dört tuplın vektöründe kutunun işaretlenmemiş kutulu değeri

Question

Daha karmaşık bir kodun parçası olarak hata ayıklamaya çalıştığım bir performans sorunu var. (Int,Int,Int,Int) dinamik, üretilebilir bir vektör oluşturmak için kullandığım append işlevi, vektöre yazılmadan önce kutunun içinde ve kutunun içinde Int neden oluyor gibi görünüyor. Bu sorunu yeniden üreten daha basit bir kod yazdım - yalnızca append işlevinde vektör büyüme işlevini eklediğimde ortaya çıkıyor - örnek kod aşağıya (sorunu çoğaltmak dışında çok yararlı bir iş yapmıyor), ardından core snippet'leri gösteren bir değer, kutu ve kutulamasının edilir:

{-# 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 gridWalk kullanım için append bir versiyonunu oluşturur. append çağrılırken

$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 kutuları değeri:

=== 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` ...) 
    } 
    } 
    } 
    } 
    } 

Yani, etkisi gridWalk değerin boks gibi görünüyor ve kutulu Int argüman unutmayın - Bu fonksiyon çekirdek $wa olduğunu (Int,Int,Int,Int) vektörüne yerleştirilmeden önce append numaralı kutudan çıkar. appendINLINE işaretleme davranışı değiştirmez - bu kutulu değerler sadece gridWalk işlev gövdesinde taşınır.

Bu değeri nasıl kutulacağınızı gösteren işaretçilere minnettar olacağım. Yenileme sırasında append'un işlevselliğini (yani kapasite aşıldığında vektör büyümesini ele almayı) istiyorum.

GHC sürüm 7.6.1'dur. Vektör sürümü 0.10'dur.

Answer 1

Bu sadece bir yorum. Ben tuple argümanı (gridWalkappend kullanımını ayarlama) kurtulmak düşündüm, ancak sonuç (sadece) son Int argüman her şeyi unboxed, bu garip görünmek için patlama olacak olması gerekir:

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 

---

yapmanız bloğunun dışında S (i+1) uygulanmasını taşımak ama bunu daha yakın ocağının bizi alırsa emin değilsem Düzen, ayrıca, sen kutulanmamış her şeyi elde

...:

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)  

Ancak liftM değiştirilirse . fmap tarafından d biz İşler iyi ise liftM (S (1+i)veyafmap (S (i+1) önüne kadar yolu taşınır gitmek geri yalnız kutusuz şunlardır: o kutulu neden bilmiyorum

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