Quali sono le possibilità per accelerare questa funzione?

Question

Sto cercando di accelerare la seguente funzione:

{-# LANGUAGE BangPatterns #-} 

import Data.Word 
import Data.Bits 
import Data.List (foldl1') 
import System.Random 
import qualified Data.List as L 

data Tree a = AB (Tree a) (Tree a) | A (Tree a) | B (Tree a) | C !a 
    deriving Show 

merge :: Tree a -> Tree a -> Tree a 
merge (C x) _    = C x 
merge _ (C y)    = C y 
merge (A ta) (A tb)   = A (merge ta tb) 
merge (A ta) (B tb)   = AB ta tb 
merge (A ta) (AB tb tc)  = AB (merge ta tb) tc 
merge (B ta) (A tb)   = AB tb ta 
merge (B ta) (B tb)   = B (merge ta tb) 
merge (B ta) (AB tb tc)  = AB tb (merge ta tc) 
merge (AB ta tb) (A tc)  = AB (merge ta tc) tb 
merge (AB ta tb) (B tc)  = AB ta (merge tb tc) 
merge (AB ta tb) (AB tc td) = AB (merge ta tc) (merge tb td) 

Per sottolineare le sue prestazioni, ho implementato ordinamento mediante merge:

fold ab a b c list = go list where 
    go (AB a' b') = ab (go a') (go b') 
    go (A a')  = a (go a') 
    go (B b')  = b (go b') 
    go (C x)  = c x 

mergeAll :: [Tree a] -> Tree a 
mergeAll = foldl1' merge 

foldrBits :: (Word32 -> t -> t) -> t -> Word32 -> t 
foldrBits cons nil word = go 32 word nil where 
    go 0 w !r = r 
    go l w !r = go (l-1) (shiftR w 1) (cons (w.&.1) r) 

word32ToTree :: Word32 -> Tree Word32 
word32ToTree w = foldrBits cons (C w) w where 
    cons 0 t = A t 
    cons 1 t = B t 

toList = fold (++) id id (\ a -> [a]) 

sort = toList . mergeAll . map word32ToTree 

main = do 
    is <- mapM (const randomIO :: a -> IO Word32) [0..500000] 
    print $ sum $ sort is 

Le prestazioni si avvicinò abbastanza buono dal movimento , intorno 2.5x più lento di Data.List s' sort. Nulla di ciò che ho fatto accelerato che ulteriormente, però: inlining diverse funzioni, sbattere le annotazioni in molti luoghi, UNPACK su C !a. C'è un modo per accelerare questa funzione?

Answer 1

Hai decisamente troppi thunk allocati. Ti faccio vedere come analizzare il codice:

merge (A ta) (A tb)   = A (merge ta tb) 

Qui si assegnano costruttore A con un solo argomento, che è un tonfo. Puoi dire quando sarà forzato il blocco merge ta tb? Probabilmente solo alla fine, quando viene utilizzato l'albero risultante. Tenta di aggiungere un botto per ciascun argomento di ogni Tree costruttore per assicurarsi che sia colonna vertebrale rigida:

data Tree a = AB !(Tree a) !(Tree a) | A !(Tree a) | B !(Tree a) | C !a 

Il prossimo esempio:

go l w !r = go (l-1) (shiftR w 1) (cons (w.&.1) r) 

Qui si assegnano un tonfo per l-1, shifrR w 1 e cons (w.&.1) r . Il primo verrà forzato nelle iterazioni successive quando si confronta l con o, il secondo sarà forzato quando si forzerà il thunk 3d nella successiva iterazione (w viene usato qui), e il terzo thunk sarà forzato alla successiva iterazione a causa di un botto su r. Quindi probabilmente questa particolare clausola va bene.