[Haskell-cafe] Ghc: -O harmful?
Don Stewart
dons at galois.com
Mon Apr 6 14:37:46 EDT 2009
-fno-state-hack?
xofon:
>
> Hello all,
>
> I have a haskell program that runs an order of magnitude slower
> when compiled with optimisations turned on. This happens on 6.8.2
> as well as 6.10.1:
>
>
> petr at r4at184:/tmp[1]% ghc --make -fforce-recomp -o out buga.hs
> [1 of 1] Compiling Main ( buga.hs, buga.o )
> Linking out ...
> petr at r4at184:/tmp% time ./out < 3-med.in >|/dev/null
> ./out < 3-med.in >| /dev/null 0,03s user 0,00s system 99% cpu 0,038 total
>
> petr at r4at184:/tmp% ghc --make -fforce-recomp -o out buga.hs -O
> [1 of 1] Compiling Main ( buga.hs, buga.o )
> Linking out ...
> petr at r4at184:/tmp% time ./out < 3-med.in >|/dev/null
> ./out < 3-med.in >| /dev/null 0,99s user 0,01s system 99% cpu 1,001 total
>
> petr at r4at184:/tmp[1]% ghc --make -fforce-recomp -o out buga.hs -O2
> [1 of 1] Compiling Main ( buga.hs, buga.o )
> Linking out ...
> petr at r4at184:/tmp% time ./out < 3-med.in >|/dev/null
> ./out < 3-med.in >| /dev/null 0,99s user 0,01s system 99% cpu 1,004 total
>
> petr at r4at184:/tmp% ghc --version
> The Glorious Glasgow Haskell Compilation System, version 6.8.2
>
>
> psxxxxxx:/tmp$ ghc --make -fforce-recomp -o out buga.hs
> [1 of 1] Compiling Main ( buga.hs, buga.o )
> Linking out ...
> psxxxxxx:/tmp$ time ./out < 3-med.in >|/dev/null
> real 0m0.028s
> user 0m0.011s
> sys 0m0.007s
>
> psxxxxxx:/tmp$ ghc --make -fforce-recomp -o out buga.hs -O
> [1 of 1] Compiling Main ( buga.hs, buga.o )
> Linking out ...
> psxxxxxx:/tmp$ time ./out < 3-med.in >|/dev/null
> real 0m0.252s
> user 0m0.225s
> sys 0m0.011s
>
> psxxxxxx:/tmp$ ghc --make -fforce-recomp -o out buga.hs -O2
> [1 of 1] Compiling Main ( buga.hs, buga.o )
> Linking out ...
> Vazeny pane, cekam na Vase rozkazy.
> psxxxxxx:/tmp$ time ./out < 3-med.in >|/dev/null
> real 0m0.239s
> user 0m0.225s
> sys 0m0.010s
>
> psxxxxxx:/tmp$ ghc --version
> The Glorious Glasgow Haskell Compilation System, version 6.10.1
>
>
> The GHC documentation states that
>
> > -O2:
> > Means: "Apply every non-dangerous optimisation, even if it means
> > significantly longer compile times." The avoided "dangerous"
> > optimisations are those that can make runtime or space worse if
> > you're unlucky. They are normally turned on or off individually.
>
> If I understand this correctly, the dangerous optimisations should not
> be performed with -O. Am I doing anything wrong? Am I hitting a bug
> in GHC optimiser? A known one?
>
>
> The program source:
>
> --------------
> petr at r4at184:/tmp$ cat buga.hs
> {-# LANGUAGE FlexibleContexts #-}
>
> import Control.Monad
> import Control.Monad.State
>
> data Predpoc a = Nic | Kus { delka :: Int,
> levy :: Predpoc a,
> pravy :: Predpoc a }
> deriving Show
>
> gList i = Kus 1 Nic Nic
>
> gPredpoc kus1 kus2 =
> Kus (delka kus1 + delka kus2)
> kus1 kus2
>
>
> pop :: MonadState [a] m => m a
> pop = get >>= \(x:xs) -> put xs >> return x
>
> mbuild :: MonadState [Int] m => Int -> m (Predpoc Int)
> mbuild 1 = gList `liftM` pop
> mbuild n = liftM2 gPredpoc (mbuild n1) (mbuild n2)
> where n1 = n`div`2
> n2 = n - n1
>
> build n li = evalState (mbuild n) li
>
> best :: Predpoc Int -> Int -> Int -> Int
> best kus i j
> | i == 1 && j == delka kus
> = delka kus
> | j <= del1 = best (levy kus) i j
> | i > del1 = best (pravy kus) (i-del1) (j-del1)
> | otherwise = best (levy kus) i del1 +
> best (pravy kus) 1 (j-del1)
> where
> del1 = delka (levy kus)
>
> main = do
> n <- read `liftM` getLine
> pole <- liftM (build n . map read . words) getLine
> replicateM_ 100 $ do
> getLine
> print $ best pole 42 420
> --------------
>
> The sample input file (30k) can be downloaded from
> http://pikomat.mff.cuni.cz/petr/3-med.in
>
> I suspect that the main's variable "pole" (which is a large
> binary tree of type Predpoc Int) may be built from scratch in each
> iteration of the replicateM_ loop.
>
> Petr
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
More information about the Haskell-Cafe
mailing list