Schreiben effiziente iterative Schleife für ST Monad

Question

worker tail-recursive loop pattern scheint sehr gut zum Schreiben von reinem Code zu arbeiten. Was wäre der gleiche Weg, um diese Art von Schleife für die ST Monade schreiben? Genauer gesagt möchte ich eine neue Heap-Zuweisung in den Schleifeniterationen vermeiden. Meine Vermutung ist entweder CPS transformation oder fixST, um den Code so umzuschreiben, dass alle Werte, die sich über die Schleife ändern, über jede Iteration weitergegeben werden, wodurch Registerpositionen (oder Stapel im Falle eines Überlaufs) für diese Werte über die Iteration verfügbar sind . Ich habe ein vereinfachtes Beispiel unten (versuchen Sie nicht, es läuft - es wird wahrscheinlich mit Segmentierungsfehler abstürzen!) findSnakes eine Funktion namens beteiligt, die ein go Arbeiter Muster hat aber die wechselnden Zustandswerte werden nicht durch Speicher Argumente übergeben:

{-# 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 #-} 

mit Blick auf cmm Ausgang in ghc 7.6.1 (mit meiner begrenzten Kenntnis der cmm - bitte korrigieren sie mich, wenn ich es falsch), sehe ich diese Art von Call-Flow, mit Schleife in s1tb_info (die in jeder Iteration Heapzuordnung und Heap-Check verursacht):

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) 

Meine Schätzung ist, dass die Überprüfung des Formulars arg >= 1 in cmm Code zu bestimmen ist, ob go Schleife beendet wurde oder nicht. Wenn das korrekt ist, scheint es, es sei denn, go Schleife wird umgeschrieben, um yp über die Schleife zu übergeben, Heap-Zuweisung wird über die Schleife für neue Werte passieren (Ich rate yp verursacht diese Heap-Zuweisung). Was wäre eine effiziente Möglichkeit, go Schleife im obigen Beispiel zu schreiben? Ich denke, yp muss als ein Argument in go Schleife, oder gleichwertiger Weg durch fixST oder CPS Transformation übergeben werden. Ich kann mir keine gute Möglichkeit vorstellen, die obige go Schleife neu zu schreiben, um Heap-Zuordnungen zu entfernen, und ich schätze die Hilfe.

Answer 1

Ich habe Ihre Funktionen neu geschrieben, um eine explizite Rekursion zu vermeiden, und einige redundante Operationen entfernt, die die Offsets berechnen. Dies ergibt einen viel schöneren Kern als Ihre ursprünglichen Funktionen.

Core ist übrigens wahrscheinlich der bessere Weg, um Ihren kompilierten Code für diese Art von Profilerstellung zu analysieren. Verwenden Sie ghc -ddump-simpl die erzeugten Kern Ausgabe zu sehen, oder Tools wie 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) 

Auch, übergeben Sie ein U.Vector Int32 zu findSnakes, nur seine Länge zu berechnen und a nie wieder verwenden. Warum nicht die Länge direkt übergeben?