#2271: floor, ceiling, round :: Double -> Int are awesomely slow
------------------------------------------+---------------------------------
    Reporter:  dons                       |        Owner:  daniel.is.fischer
        Type:  bug                        |       Status:  patch            
    Priority:  low                        |    Milestone:  7.0.1            
   Component:  libraries/base             |      Version:  7.1              
    Keywords:  performance, math, double  |     Testcase:                   
   Blockedby:                             |   Difficulty:  Unknown          
          Os:  Unknown/Multiple           |     Blocking:                   
Architecture:  Unknown/Multiple           |      Failure:  None/Unknown     
------------------------------------------+---------------------------------

Comment(by michalt):

 With the new patch GHC builds without any problems. I've run the testsuite
 for
 HEAD with and without the patch and the only difference is failure in
 arith005
 (more about it below). I haven't played with the QC tests, as quickcheck
 apparently doesn't build with HEAD atm (maybe I'll do it when I have more
 time).

 Replying to [comment:17 daniel.is.fischer]:
 > Oh, btw. due to the rewrite rules, in arith005, we get different
 nonsense for
 > the overflowing values with optimisations than a) before, b) without
 > optimisations.

 I think the difference that the tests were catching was the fact that
 `-0.0` is
 handled differently by `properFraction`:
 {{{
 module Main where

 main = do
   print $ (properFraction (-0.0) :: (Int,Float))
   print $ (properFraction (-0.0) :: (Integer,Float))
   print $ (properFraction (-0.0) :: (Int,Double))
   print $ (properFraction (-0.0) :: (Integer,Double))
 }}}
 with the patch:
 {{{
 > ~/develop/ghc-mod/inplace/bin/ghc-stage2 --make -fforce-recomp Test
 [1 of 1] Compiling Main             ( Test.hs, Test.o )
 Linking Test ...
 > ./Test
 (0,0.0)
 (0,0.0)
 (0,0.0)
 (0,0.0)
 > ~/develop/ghc-mod/inplace/bin/ghc-stage2 -O2 --make -fforce-recomp Test
 [1 of 1] Compiling Main             ( Test.hs, Test.o )
 Linking Test ...
 > ./Test
 (0,-0.0)
 (0,0.0)
 (0,-0.0)
 (0,0.0)

 }}}
 Without the patch the result is always `(0,0.0)`.

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/2271#comment:27>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to