Каковы возможные ключи оптимизации Haskell?

Question

Я нашел тест, который решает очень простую задачу на разных языках https://github.com/starius/lang-bench. Вот, код Haskell:

cmpsum i j k = 
    if i + j == k then 1 else 0 

main = print (sum([cmpsum i j k | 
    i <- [1..1000], j <- [1..1000], k <- [1..1000]])) 

Этот код работает очень медленно, как вы можете видеть в тесте, и я нашел, что это очень странно. Я пытался встроить функцию cmpsum и скомпилировать со следующими флагами:

ghc -c -O2 main.hs 

, но это действительно не помогло. Я не спрашиваю об оптимизации алгоритма, потому что он одинаковый для всех языков, но о возможных компиляторах или оптимизации кода, которые могут сделать этот код быстрее.

Answer 1

Вы сравниваете цикл по одному оператору с подсчетом путем создания промежуточной структуры (списка) и складывания по ней. Я не знаю, насколько велика производительность на Java, если бы вы создали связанный список с миллиардом элементов, итератированных над ним.

Вот код Haskell, который (приблизительно) эквивалентен вашему Java-коду.

{-# LANGUAGE BangPatterns #-} 

main = print (loop3 1 1 1 0) 

loop1 :: Int -> Int -> Int -> Int -> Int 
loop1 !i !j !k !cc | k <= 1000 = loop1 i j (k+1) (cc + fromEnum (i + j == k)) 
        | otherwise = cc 

loop2 :: Int -> Int -> Int -> Int -> Int 
loop2 !i !j !k !cc | j <= 1000 = loop2 i (j+1) k (loop1 i j k cc) 
        | otherwise = cc 

loop3 :: Int -> Int -> Int -> Int -> Int 
loop3 !i !j !k !cc | i <= 1000 = loop3 (i+1) j k (loop2 i j k cc) 
        | otherwise = cc 

И исполнение на моей машине (test2 вашего кода Haskell):

$ ghc --make -O2 test1.hs && ghc --make -O2 test2.hs && javac test3.java 
$ time ./test1.exe && time ./test2.exe && time java test3 
499500 

real 0m1.614s 
user 0m0.000s 
sys  0m0.000s 
499500 

real 0m35.922s 
user 0m0.000s 
sys  0m0.000s 
499500 

real 0m1.589s 
user 0m0.000s 
sys  0m0.015s 

Answer 2

Не полный ответ, извините. Компиляция с GHC 7.10 на моей машине. Я получаю ~ 12 секунд для вашей версии.

Я предлагаю всегда компилировать с помощью -Wall, который показывает нам, что наши номера дефолтны для бесконечной точности Integer. Исправлено:

module Main where 

cmpsum :: Int -> Int -> Int -> Int 
cmpsum i j k = 
    if i + j == k then 1 else 0 

main :: IO() 
main = print (sum([cmpsum i j k | 
    i <- [1..1000], j <- [1..1000], k <- [1..1000]])) 

Это работает в ~ 5 секунд для меня. Бег с +RTS -s кажется, показать, что мы имеем цикл в постоянной памяти:

  87,180 bytes allocated in the heap 
      1,704 bytes copied during GC 
      42,580 bytes maximum residency (1 sample(s)) 
      18,860 bytes maximum slop 
       1 MB total memory in use (0 MB lost due to fragmentation) 

            Tot time (elapsed) Avg pause Max pause 
    Gen 0   0 colls,  0 par 0.000s 0.000s  0.0000s 0.0000s 
    Gen 1   1 colls,  0 par 0.000s 0.000s  0.0001s 0.0001s 

    INIT time 0.000s ( 0.001s elapsed) 
    MUT  time 4.920s ( 4.919s elapsed) 
    GC  time 0.000s ( 0.000s elapsed) 
    EXIT time 0.000s ( 0.000s elapsed) 
    Total time 4.920s ( 4.921s elapsed) 

    %GC  time  0.0% (0.0% elapsed) 

    Alloc rate 17,719 bytes per MUT second 

    Productivity 100.0% of total user, 100.0% of total elapsed 

-fllvm сбривает другую секунду или около того. Возможно, кто-то еще сможет заглянуть в нее дальше.

Редактировать: Просто копайте в этом немного дальше. Это не похоже на слияние. Даже если я изменю sum на foldr (+) 0, который является явной партой "good producer/good consumer".

Rec { 
$wgo [InlPrag=[0], Occ=LoopBreaker] :: Int# -> Int# 
[GblId, Arity=1, Str=DmdType <S,U>] 
$wgo = 
    \ (w :: Int#) -> 
    let { 
     $j :: Int# -> Int# 
     [LclId, Arity=1, Str=DmdType] 
     $j = 
     \ (ww [OS=OneShot] :: Int#) -> 
      letrec { 
      $wgo1 [InlPrag=[0], Occ=LoopBreaker] :: [Int] -> Int# 
      [LclId, Arity=1, Str=DmdType <S,1*U>] 
      $wgo1 = 
       \ (w1 :: [Int]) -> 
       case w1 of _ [Occ=Dead] { 
        [] -> ww; 
        : y ys -> 
        case $wgo1 ys of ww1 { __DEFAULT -> 
        case lvl of _ [Occ=Dead] { 
         [] -> ww1; 
         : y1 ys1 -> 
         case y of _ [Occ=Dead] { I# y2 -> 
         case y1 of _ [Occ=Dead] { I# y3 -> 
         case tagToEnum# @ Bool (==# (+# w y2) y3) of _ [Occ=Dead] { 
          False -> 
          letrec { 
           $wgo2 [InlPrag=[0], Occ=LoopBreaker] :: [Int] -> Int# 
           [LclId, Arity=1, Str=DmdType <S,1*U>] 
           $wgo2 = 
           \ (w2 :: [Int]) -> 
            case w2 of _ [Occ=Dead] { 
            [] -> ww1; 
            : y4 ys2 -> 
             case y4 of _ [Occ=Dead] { I# y5 -> 
             case tagToEnum# @ Bool (==# (+# w y2) y5) of _ [Occ=Dead] { 
             False -> $wgo2 ys2; 
             True -> case $wgo2 ys2 of ww2 { __DEFAULT -> +# 1 ww2 } 
             } 
             } 
            }; } in 
          $wgo2 ys1; 
          True -> 
          letrec { 
           $wgo2 [InlPrag=[0], Occ=LoopBreaker] :: [Int] -> Int# 
           [LclId, Arity=1, Str=DmdType <S,1*U>] 
           $wgo2 = 
           \ (w2 :: [Int]) -> 
            case w2 of _ [Occ=Dead] { 
            [] -> ww1; 
            : y4 ys2 -> 
             case y4 of _ [Occ=Dead] { I# y5 -> 
             case tagToEnum# @ Bool (==# (+# w y2) y5) of _ [Occ=Dead] { 
             False -> $wgo2 ys2; 
             True -> case $wgo2 ys2 of ww2 { __DEFAULT -> +# 1 ww2 } 
             } 
             } 
            }; } in 
          case $wgo2 ys1 of ww2 { __DEFAULT -> +# 1 ww2 } 
         } 
         } 
         } 
        } 
        } 
       }; } in 
      $wgo1 lvl } in 
    case w of wild { 
     __DEFAULT -> case $wgo (+# wild 1) of ww { __DEFAULT -> $j ww }; 
     1000 -> $j 0 
    } 
end Rec } 

В самом деле, глядя на ядро ​​для print $ foldr (+) (0:: Int) $ [ i+j | i <- [0..10000], j <- [0..10000]], кажется, как будто только первый слой списка понимания сливают. Это ошибка?

Answer 3

Этот код получает работу в течение 1 секунды и без дополнительного выделения в GHC 7.10 с -O2 (см дна для вывода профилирования):

cmpsum :: Int -> Int -> Int -> Int 
cmpsum i j k = fromEnum (i+j==k) 

main = print $ sum [cmpsum i j k | i <- [1..1000], 
            j <- [1..const 1000 i], 
            k <- [1..const 1000 j]] 

в GHC 7.8, вы можете получить почти те же результаты в этом случае (1.4 секунды), если добавить следующую строку в начале:

import Prelude hiding (sum) 

sum xs = foldr (\x r a -> a `seq` r (a+x)) id xs 0 

Там три вопроса здесь:

1. Специализируется код для Int вместо того, чтобы он по умолчанию Integer имеет решающее значение.

2. GHC 7.10 предлагает список сплайсов для sum, что GHC 7.8 нет. Это связано с тем, что новое определение sum, основанное на новом определении foldl, может быть очень плохо в некоторых случаях без анализа «ясности» Joachim Breitner, созданного для GHC 7.10.

3. GHC выполняет ограниченную передачу «полной лень» в начале компиляции, прежде чем произойдет какая-либо вставка. В результате константы [1..1000] для j и k, которые используются несколько раз в цикле, выходят из цикла. Это было бы хорошо, если бы они были действительно дорогими для расчета, но в этом контексте гораздо дешевле делать дополнения снова и снова, а не сохранять результаты. Что делает код выше, это трюк GHC. Поскольку const не вложен, пока немного позже, этот первый полный проезд лень не видит, что списки постоянны, поэтому они не вытаскивают их. Я написал это так, потому что это красиво и коротко, но это, по общему признанию, немного на хрупкой стороне. Для того, чтобы сделать его более устойчивым, использование фазированной встраивание:

   main = print $ sum [cmpsum i j k | i <- [1..1000], 
               j <- [1..konst 1000 i], 
               k <- [1..konst 1000 j]] 
   
   {-# INLINE [1] konst #-} 
   konst = const 
   

   Это гарантирует, что konst будет встраиваются в Simplifier фазе 1, но не ранее. Фаза 1 происходит после список завершен, поэтому совершенно безопасно видеть, что GHC все видит.

  51,472 bytes allocated in the heap 
      3,408 bytes copied during GC 
      44,312 bytes maximum residency (1 sample(s)) 
      17,128 bytes maximum slop 
       1 MB total memory in use (0 MB lost due to fragmentation) 

            Tot time (elapsed) Avg pause Max pause 
    Gen 0   0 colls,  0 par 0.000s 0.000s  0.0000s 0.0000s 
    Gen 1   1 colls,  0 par 0.000s 0.000s  0.0002s 0.0002s 

    INIT time 0.000s ( 0.000s elapsed) 
    MUT  time 1.071s ( 1.076s elapsed) 
    GC  time 0.000s ( 0.000s elapsed) 
    EXIT time 0.000s ( 0.000s elapsed) 
    Total time 1.073s ( 1.077s elapsed) 

    %GC  time  0.0% (0.0% elapsed) 

    Alloc rate 48,059 bytes per MUT second 

    Productivity 99.9% of total user, 99.6% of total elapsed