Khả năng tăng tốc chức năng này là gì?

Question

Tôi cố gắng để đẩy nhanh tiến độ các chức năng sau:

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

Để nhấn mạnh hiệu quả của nó, tôi đã thực hiện loại sử dụng 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 

Việc thực hiện đã đưa ra khá tốt từ đường đi , chậm hơn khoảng 2,5x so với sort của Data.List. Không có gì mà tôi đã tăng tốc thêm nữa, mặc dù: nhấn mạnh một số chức năng, ghi chú bằng giọng nói ở nhiều nơi, UNPACK trên C !a. Có cách nào để tăng tốc độ chức năng này không?

Answer 1

Bạn chắc chắn có quá nhiều lượt được phân bổ. Tôi sẽ chỉ cách phân tích mã:

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

Ở đây bạn phân bổ hàm tạo A với một đối số, đó là một đoạn. Bạn có thể nói khi đoạn merge ta tb bị ép buộc không? Có lẽ chỉ ở cuối cùng, khi cây kết quả được sử dụng. Cố gắng thêm một tiếng nổ cho mỗi đối số của mỗi Tree constructor để đảm bảo nó là cột sống-nghiêm ngặt:

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

Ví dụ tiếp theo:

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

Ở đây bạn được phân bổ một thunk cho l-1, shifrR w 1 và cons (w.&.1) r . Người đầu tiên sẽ bị buộc phải lặp lại lần tiếp theo khi so sánh l với o, lần thứ hai sẽ bị buộc khi buộc đoạn thứ ba trong lần lặp tiếp theo (w được sử dụng tại đây) và đoạn thứ ba bị buộc phải lặp lại tiếp theo vì một tiếng nổ trên r. Vì vậy, có lẽ điều khoản cụ thể này là OK.