# Por que esse código Haskell é executado mais lentamente com -O?

88

Este pedaço de código Haskell é executado muito mais devagar `-O`, mas não`-O` deve ser perigoso . Alguém pode me dizer o que aconteceu? Se for importante, é uma tentativa de resolver este problema e usa pesquisa binária e árvore de segmento persistente:

``````import Control.Monad
import Data.Array

data Node =
Leaf   Int           -- value
| Branch Int Node Node -- sum, left child, right child
type NodeArray = Array Int Node

-- create an empty node with range [l, r)
create :: Int -> Int -> Node
create l r
| l + 1 == r = Leaf 0
| otherwise  = Branch 0 (create l m) (create m r)
where m = (l + r) `div` 2

-- Get the sum in range [0, r). The range of the node is [nl, nr)
sumof :: Node -> Int -> Int -> Int -> Int
sumof (Leaf val) r nl nr
| nr <= r   = val
| otherwise = 0
sumof (Branch sum lc rc) r nl nr
| nr <= r   = sum
| r  > nl   = (sumof lc r nl m) + (sumof rc r m nr)
| otherwise = 0
where m = (nl + nr) `div` 2

-- Increase the value at x by 1. The range of the node is [nl, nr)
increase :: Node -> Int -> Int -> Int -> Node
increase (Leaf val) x nl nr = Leaf (val + 1)
increase (Branch sum lc rc) x nl nr
| x < m     = Branch (sum + 1) (increase lc x nl m) rc
| otherwise = Branch (sum + 1) lc (increase rc x m nr)
where m = (nl + nr) `div` 2

-- signature said it all
tonodes :: Int -> [Int] -> [Node]
tonodes n = reverse . tonodes' . reverse
where
tonodes' :: [Int] -> [Node]
tonodes' (h:t) = increase h' h 0 n : s' where s'@(h':_) = tonodes' t
tonodes' _ = [create 0 n]

-- find the minimum m in [l, r] such that (predicate m) is True
binarysearch :: (Int -> Bool) -> Int -> Int -> Int
binarysearch predicate l r
| l == r      = r
| predicate m = binarysearch predicate l m
| otherwise   = binarysearch predicate (m+1) r
where m = (l + r) `div` 2

-- main, literally
main :: IO ()
main = do
[n, m] <- fmap (map read . words) getLine
nodes <- fmap (listArray (0, n) . tonodes n . map (subtract 1) . map read . words) getLine
replicateM_ m \$ query n nodes
where
query :: Int -> NodeArray -> IO ()
query n nodes = do
[p, k] <- fmap (map read . words) getLine
print \$ binarysearch (ok nodes n p k) 0 n
where
ok :: NodeArray -> Int -> Int -> Int -> Int -> Bool
ok nodes n p k s = (sumof (nodes ! min (p + s + 1) n) s 0 n) - (sumof (nodes ! max (p - s) 0) s 0 n) >= k``````

(Este é exatamente o mesmo código com revisão de código, mas esta questão aborda outro problema.)

``````#include <cstdio>
#include <cstdlib>
using namespace std;
int main (int argc, char * argv[]) {
srand(1827);
int n = 100000;
if(argc > 1)
sscanf(argv[1], "%d", &n);
printf("%d %d\n", n, n);
for(int i = 0; i < n; i++)
printf("%d%c", rand() % n + 1, i == n - 1 ? '\n' : ' ');
for(int i = 0; i < n; i++) {
int p = rand() % n;
int k = rand() % n + 1;
printf("%d %d\n", p, k);
}
}``````

Caso você não tenha um compilador C ++ disponível, este é o resultado de`./gen.exe 1000` .

``````\$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 7.8.3
\$ ghc -fforce-recomp 1827.hs
[1 of 1] Compiling Main             ( 1827.hs, 1827.o )
\$ time ./gen.exe 1000 | ./1827.exe > /dev/null
real    0m0.088s
user    0m0.015s
sys     0m0.015s
\$ ghc -fforce-recomp -O 1827.hs
[1 of 1] Compiling Main             ( 1827.hs, 1827.o )
\$ time ./gen.exe 1000 | ./1827.exe > /dev/null
real    0m2.969s
user    0m0.000s
sys     0m0.045s``````

E este é o resumo do perfil de heap:

``````\$ ghc -fforce-recomp -rtsopts ./1827.hs
[1 of 1] Compiling Main             ( 1827.hs, 1827.o )
\$ ./gen.exe 1000 | ./1827.exe +RTS -s > /dev/null
70,207,096 bytes allocated in the heap
2,112,416 bytes copied during GC
613,368 bytes maximum residency (3 sample(s))
28,816 bytes maximum slop
3 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed)  Avg pause  Max pause
Gen  0       132 colls,     0 par    0.00s    0.00s     0.0000s    0.0004s
Gen  1         3 colls,     0 par    0.00s    0.00s     0.0006s    0.0010s
INIT    time    0.00s  (  0.00s elapsed)
MUT     time    0.03s  (  0.03s elapsed)
GC      time    0.00s  (  0.01s elapsed)
EXIT    time    0.00s  (  0.00s elapsed)
Total   time    0.03s  (  0.04s elapsed)
%GC     time       0.0%  (14.7% elapsed)
Alloc rate    2,250,213,011 bytes per MUT second
Productivity 100.0% of total user, 83.1% of total elapsed
\$ ghc -fforce-recomp -O -rtsopts ./1827.hs
[1 of 1] Compiling Main             ( 1827.hs, 1827.o )
\$ ./gen.exe 1000 | ./1827.exe +RTS -s > /dev/null
6,009,233,608 bytes allocated in the heap
622,682,200 bytes copied during GC
443,240 bytes maximum residency (505 sample(s))
48,256 bytes maximum slop
3 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed)  Avg pause  Max pause
Gen  0     10945 colls,     0 par    0.72s    0.63s     0.0001s    0.0004s
Gen  1       505 colls,     0 par    0.16s    0.13s     0.0003s    0.0005s
INIT    time    0.00s  (  0.00s elapsed)
MUT     time    2.00s  (  2.13s elapsed)
GC      time    0.87s  (  0.76s elapsed)
EXIT    time    0.00s  (  0.00s elapsed)
Total   time    2.89s  (  2.90s elapsed)
%GC     time      30.3%  (26.4% elapsed)
Alloc rate    3,009,412,603 bytes per MUT second
Productivity  69.7% of total user, 69.4% of total elapsed``````

1
Obrigado por incluir a versão GHC!
dfeuer

2
@dfeuer O resultado agora está incluído na minha pergunta.
johnchen902

13
Mais uma opção para tentar: `-fno-state-hack`. Então, terei de realmente tentar examinar os detalhes.
dfeuer

17
Não sei muitos detalhes, mas basicamente é uma heurística para adivinhar que certas funções que seu programa cria (nomeadamente aquelas ocultas nos tipos `IO`ou `ST`) são chamadas apenas uma vez. Geralmente é um bom palpite, mas quando é um palpite ruim, GHC pode produzir um código muito ruim. Os desenvolvedores há muito tempo tentam encontrar uma maneira de obter o que é bom sem o que é ruim. Acho que Joachim Breitner está trabalhando nisso atualmente.
dfeuer

2
Isso se parece muito com ghc.haskell.org/trac/ghc/ticket/10102 . Observe que ambos os programas usam `replicateM_`, e o GHC moverá erroneamente a computação de fora `replicateM_`para dentro, repetindo-a, portanto.
Joachim Breitner

Respostas:

42

## O que aconteceu ao seu código com `-O`

Deixe-me ampliar sua função principal e reescrevê-la um pouco:

``````main :: IO ()
main = do
[n, m] <- fmap (map read . words) getLine
line <- getLine
let nodes = listArray (0, n) . tonodes n . map (subtract 1) . map read . words \$ line
replicateM_ m \$ query n nodes``````

Claramente, a intenção aqui é que o `NodeArray`seja criado uma vez e, em seguida, usado em todas as `m`invocações de `query`.

Infelizmente, o GHC transforma este código em, efetivamente,

``````main = do
[n, m] <- fmap (map read . words) getLine
line <- getLine
replicateM_ m \$ do
let nodes = listArray (0, n) . tonodes n . map (subtract 1) . map read . words \$ line
query n nodes``````

e você pode ver imediatamente o problema aqui.

## Qual é o hack de estado e por que ele destrói o desempenho de meus programas

O motivo é o hack do estado, que diz (aproximadamente): “Quando algo é do tipo `IO a`, suponha que seja chamado apenas uma vez.”. A documentação oficial não é muito mais elaborada:

`-fno-state-hack`

Desative o "hack de estado" pelo qual qualquer lambda com um token de estado # como argumento é considerado uma entrada única, portanto, é considerado OK incorporar as coisas dentro dele. Isso pode melhorar o desempenho do código de mônada IO e ST, mas corre o risco de reduzir o compartilhamento.

Grosso modo, a ideia é a seguinte: se você definir uma função com um `IO`tipo e uma cláusula where, por exemplo

``````foo x = do
putStrLn y
putStrLn y
where y = ...x...``````

Algo do tipo `IO a`pode ser visto como algo do tipo `RealWord -> (a, RealWorld)`. Nessa visão, o acima se torna (aproximadamente)

``````foo x =
let y = ...x... in
\world1 ->
let (world2, ()) = putStrLn y world1
let (world3, ()) = putStrLn y world2
in  (world3, ())``````

Uma chamada para `foo`seria (normalmente) assim `foo argument world`. Mas a definição de `foo`leva apenas um argumento, e o outro só é consumido mais tarde por uma expressão lambda local! Essa vai ser uma chamada muito lenta para `foo`. Seria muito mais rápido se o código fosse assim:

``````foo x world1 =
let y = ...x... in
let (world2, ()) = putStrLn y world1
let (world3, ()) = putStrLn y world2
in  (world3, ())``````

Isso é chamado de eta-expansão e feito por vários motivos (por exemplo, analisando a definição da função , verificando como ela está sendo chamada e - neste caso - heurísticas direcionadas por tipo).

Infelizmente, isso prejudica o desempenho se a chamada para `foo`for realmente na forma `let fooArgument = foo argument`, ou seja, com um argumento, mas não for `world`aprovada (ainda). No código original, se `fooArgument`for usado várias vezes, `y`ainda será calculado apenas uma vez e compartilhado. No código modificado, `y`será recalculado todas as vezes - exatamente o que aconteceu com o seu `nodes`.

## As coisas podem ser consertadas?

Possivelmente. Veja # 9388 para uma tentativa de fazer isso. O problema com a corrigi-lo é que ele vai custar desempenho em uma série de casos em que a transformação acontece com ok, embora o compilador não pode saber isso com certeza. E provavelmente há casos em que tecnicamente não está ok, ou seja, o compartilhamento é perdido, mas ainda é benéfico porque a aceleração da chamada mais rápida supera o custo extra do recálculo. Portanto, não está claro para onde ir a partir daqui.

4
Muito interessante! Mas não entendi muito bem por quê: "o outro só é consumido depois por uma expressão lambda local! Essa vai ser uma chamada muito lenta para `foo`"?
imz - Ivan Zakharyaschev

Existe alguma solução alternativa para um caso local específico? `-f-no-state-hack`quando a compilação parece muito pesada. `{-# NOINLINE #-}`parece a coisa óbvia, mas não consigo pensar em como aplicá-la aqui. Talvez bastasse apenas fazer `nodes`uma ação IO e contar com o sequenciamento de `>>=`?
Barend Venter

Também vi que substituir `replicateM_ n foo`por `forM_ (\_ -> foo) [1..n]`ajuda.
Joachim Breitner
Ao utilizar nosso site, você reconhece que leu e compreendeu nossa Política de Cookies e nossa Política de Privacidade.