[commit: ghc] ghc-8.0: Mark GHC.Real.even and odd as INLINEABLE (9246525)

git at git.haskell.org git at git.haskell.org
Wed Mar 23 16:37:55 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/92465259ae875a2fece5ab37a45e358ba1819d83/ghc

>---------------------------------------------------------------

commit 92465259ae875a2fece5ab37a45e358ba1819d83
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Mon Mar 14 13:27:23 2016 +0100

    Mark GHC.Real.even and odd as INLINEABLE
    
    Previously they were merely specialised at Int and Integer. It seems to
    me that these are cheap enough to be worth inlining. See #11701 for
    motivation.
    
    Test Plan: Validate
    
    Reviewers: austin, hvr, simonpj
    
    Reviewed By: simonpj
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D1997
    
    GHC Trac Issues: #11701
    
    (cherry picked from commit 2841ccab595ce38fb86b789574f057c3abe3d630)


>---------------------------------------------------------------

92465259ae875a2fece5ab37a45e358ba1819d83
 libraries/base/GHC/Real.hs | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/libraries/base/GHC/Real.hs b/libraries/base/GHC/Real.hs
index 186be27..3a97f1f 100644
--- a/libraries/base/GHC/Real.hs
+++ b/libraries/base/GHC/Real.hs
@@ -463,10 +463,8 @@ showSigned showPos p x
 even, odd       :: (Integral a) => a -> Bool
 even n          =  n `rem` 2 == 0
 odd             =  not . even
-{-# SPECIALISE even :: Int -> Bool #-}
-{-# SPECIALISE odd  :: Int -> Bool #-}
-{-# SPECIALISE even :: Integer -> Bool #-}
-{-# SPECIALISE odd  :: Integer -> Bool #-}
+{-# INLINEABLE even #-}
+{-# INLINEABLE odd  #-}
 
 -------------------------------------------------------
 -- | raise a number to a non-negative integral power



More information about the ghc-commits mailing list