STモナドのための効率的な反復ループの作成

Question

goworker tail-recursive loop patternは、純粋なコードを書くために非常にうまくいくようです。 STモナドのためのそのようなループを書くのと同等の方法は何でしょうか？より具体的には、私はループの反復で新しいヒープ割り当てを避けたい。私の推測では、CPS transformationまたはfixSTのいずれかが含まれているため、ループ全体で変化するすべての値が各繰り返しにわたって渡されるため、レジスタ位置（または流出の場合はスタック）を反復。私はgoワーカーパターンを持っていますが、変化する状態値はアキュムレータ引数を通さないfindSnakesという関数を含む下記の単純化された例を（実行しようとしません - セグメンテーションフォールトでクラッシュする可能性があります）：

{-# 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 as CM (when,forM_) 
import Data.Int 

type MVI1 s = MVector (PrimState (ST s)) Int 

-- function to find previous y 
findYP :: MVI1 s -> Int -> Int -> ST s Int 
findYP fp k offset = do 
       y0 <- MU.unsafeRead fp (k+offset-1) >>= \x -> return $ 1+x 
       y1 <- MU.unsafeRead fp (k+offset+1) 
       if y0 > y1 then return y0 
       else return y1 
{-#INLINE findYP #-} 

findSnakes :: Vector Int32 -> MVI1 s -> Int -> Int -> (Int -> Int -> Int) -> ST s() 
findSnakes a fp !k !ct !op = go 0 k 
    where 
      offset=1+U.length a 
      go x k' 
      | x < ct = do 
       yp <- findYP fp k' offset 
       MU.unsafeWrite fp (k'+offset) (yp + k') 
       go (x+1) (op k' 1) 
      | otherwise = return() 
{-#INLINE findSnakes #-} 

（cmmの私の限られた知識で - 私はそれが間違って得た場合、私を修正してください）ghc 7.6.1にcmm出力を見ると、私は、各反復でヒープの割り当てやヒープチェックを起こしs1tb_infoのループ（と、コールフローのこの種を見ます）：

findSnakes_info -> a1_r1qd_info -> $wa_r1qc_info (new stack allocation, SpLim check) 
-> s1sy_info -> s1sj_info: if arg > 1 then s1w8_info else R1 (can't figure out 
what that register points to) 

-- I am guessing this one below is for go loop 
s1w8_info -> s1w7_info (big heap allocation, HpLim check) -> s1tb_info: if arg >= 1 
then s1td_info else R1 

s1td_info (big heap allocation, HpLim check) -> if arg >= 1 then s1tb_info 
(a loop) else s1tb_info (after executing a different block of code) 

cmmコード内のarg >= 1という形式のチェックは、goループが終了したかどうかを判断することです。それが正しいとすれば、ループがループ全体にypを渡すように書き換えられない限り、新しい値のためにループ全体でヒープ割り当てが行われます（ypがそのヒープ割り当てを引き起こしていると推測しています）。上の例でループをgoと書くと効率的な方法は何でしょうか？私はypがgoループの引数として、または同等の方法でfixSTまたはCPSの変換で渡されなければならないと思います。私はヒープ割り当てを削除する上記のループgoを書き直す良い方法を考えることができず、それに助けていただければ幸いです。

Answer 1

明示的な再帰を避けるために関数を書き直し、オフセットを計算するいくつかの冗長演算を削除しました。これは元の関数よりもはるかに良いコアにコンパイルされます。

コアは、この種のプロファイリングのためにコンパイルされたコードを分析するための最良の方法です。生成されたコアの出力を見るためにghc -ddump-simplを使用するか、またはghc-core

import Control.Monad.Primitive                    
import Control.Monad.ST                      
import Data.Int                        
import qualified Data.Vector.Unboxed.Mutable as M                
import qualified Data.Vector.Unboxed as U                  

type MVI1 s = M.MVector (PrimState (ST s)) Int                

findYP :: MVI1 s -> Int -> ST s Int                                      
findYP fp offset = do                      
    y0 <- M.unsafeRead fp (offset+0)                  
    y1 <- M.unsafeRead fp (offset+2)                  
    return $ max (y0 + 1) y1                     

findSnakes :: U.Vector Int32 -> MVI1 s -> Int -> Int -> (Int -> Int -> Int) -> ST s()                           
findSnakes a fp k0 ct op = U.mapM_ writeAt $ U.iterateN ct (`op` 1) k0          
    where writeAt k = do  
       let offset = U.length a + k                 
       yp <- findYP fp offset                   
       M.unsafeWrite fp (offset + 1) (yp + k) 

      -- or inline findYP manually 
      writeAt k = do 
      let offset = U.length a + k 
      y0 <- M.unsafeRead fp (offset + 0) 
      y1 <- M.unsafeRead fp (offset + 2) 
      M.unsafeWrite fp (offset + 1) (k + max (y0 + 1) y1) 

のようなツールはまた、あなただけの長さを計算しないようにし、二度とaを使用し、findSnakesにU.Vector Int32を渡します。長さを直接渡すのはなぜですか？