什么是可能的Haskell优化键?

时间:2015-01-27 18:22:46

标签: haskell compiler-optimization

我发现基准可以解决不同语言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

但它确实无济于事。我不是要求优化算法,因为它对所有语言都是一样的,但是关于可能使编码运行得更快的编译器或代码优化。

3 个答案:

答案 0 :(得分:9)

不是完整的答案,对不起。在我的机器上使用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更改为明确"good producer/good consumer"对的foldr (+) 0

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]]的核心,似乎只有列表推导的第一层融合了。这是一个错误吗?

答案 1 :(得分:6)

此代码在1秒内完成工作,并且在-O2的GHC 7.10中没有额外分配(请参见底部的分析输出):

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提供GHC 7.8没有的sum列表融合。这是因为sum的新定义,基于foldl的新定义,在某些情况下,如果没有&#34; call arity&#34;分析Joachim Breitner为GHC 7.10创建。

  3. GHC执行有限的&#34;完全懒惰&#34;在任何内联发生之前,在编译中很早就通过。因此,在循环中多次使用的[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将在简化阶段1中内联,但不会更早。在列表融合完成后,第1阶段发生,因此让GHC看到所有内容是完全安全的。

  4.           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
    

答案 2 :(得分:5)

您正在通过生成中间结构(列表)并折叠它来将单个语句上的循环与计数进行比较。我不知道如果你创建一个迭代了十亿个元素的链表,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