[commit: ghc] master: base: Remove redundant subtraction in (^) and stimes (eb5a40c)

git at git.haskell.org git at git.haskell.org
Wed Nov 22 02:48:06 UTC 2017


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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/eb5a40cea6c64f5300c7697231cb0ede2c554388/ghc

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

commit eb5a40cea6c64f5300c7697231cb0ede2c554388
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Tue Nov 21 21:15:29 2017 -0500

    base: Remove redundant subtraction in (^) and stimes
    
    Subtraction `y - 1` is redundant. The value of y is guaranteed to be
    positive and odd, so
    ```
    (y - 1) `quot` 2` = `y `quot` 2
    ```
    
    Test Plan: validate
    
    Reviewers: hvr, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie
    
    GHC Trac Issues: #14439
    
    Differential Revision: https://phabricator.haskell.org/D4173


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

eb5a40cea6c64f5300c7697231cb0ede2c554388
 libraries/base/Data/Semigroup/Internal.hs | 14 ++++++++++----
 libraries/base/GHC/Real.hs                | 10 ++++++++--
 2 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/libraries/base/Data/Semigroup/Internal.hs b/libraries/base/Data/Semigroup/Internal.hs
index 3cdf54b..7d163bd 100644
--- a/libraries/base/Data/Semigroup/Internal.hs
+++ b/libraries/base/Data/Semigroup/Internal.hs
@@ -60,11 +60,11 @@ stimesMonoid n x0 = case compare n 0 of
       f x y
         | even y = f (x `mappend` x) (y `quot` 2)
         | y == 1 = x
-        | otherwise = g (x `mappend` x) (pred y  `quot` 2) x
+        | otherwise = g (x `mappend` x) (y `quot` 2) x               -- See Note [Half of y - 1]
       g x y z
         | even y = g (x `mappend` x) (y `quot` 2) z
         | y == 1 = x `mappend` z
-        | otherwise = g (x `mappend` x) (pred y `quot` 2) (x `mappend` z)
+        | otherwise = g (x `mappend` x) (y `quot` 2) (x `mappend` z) -- See Note [Half of y - 1]
 
 -- this is used by the class definitionin GHC.Base;
 -- it lives here to avoid cycles
@@ -76,11 +76,17 @@ stimesDefault y0 x0
     f x y
       | even y = f (x <> x) (y `quot` 2)
       | y == 1 = x
-      | otherwise = g (x <> x) (pred y  `quot` 2) x
+      | otherwise = g (x <> x) (y `quot` 2) x        -- See Note [Half of y - 1]
     g x y z
       | even y = g (x <> x) (y `quot` 2) z
       | y == 1 = x <> z
-      | otherwise = g (x <> x) (pred y `quot` 2) (x <> z)
+      | otherwise = g (x <> x) (y `quot` 2) (x <> z) -- See Note [Half of y - 1]
+
+{- Note [Half of y - 1]
+   ~~~~~~~~~~~~~~~~~~~~~
+   Since y is guaranteed to be odd and positive here,
+   half of y - 1 can be computed as y `quot` 2, optimising subtraction away.
+-}
 
 stimesMaybe :: (Integral b, Semigroup a) => b -> Maybe a -> Maybe a
 stimesMaybe _ Nothing = Nothing
diff --git a/libraries/base/GHC/Real.hs b/libraries/base/GHC/Real.hs
index f30a53e..4ab4b2f 100644
--- a/libraries/base/GHC/Real.hs
+++ b/libraries/base/GHC/Real.hs
@@ -493,17 +493,23 @@ x0 ^ y0 | y0 < 0    = errorWithoutStackTrace "Negative exponent"
     where -- f : x0 ^ y0 = x ^ y
           f x y | even y    = f (x * x) (y `quot` 2)
                 | y == 1    = x
-                | otherwise = g (x * x) ((y - 1) `quot` 2) x
+                | otherwise = g (x * x) (y `quot` 2) x         -- See Note [Half of y - 1]
           -- g : x0 ^ y0 = (x ^ y) * z
           g x y z | even y = g (x * x) (y `quot` 2) z
                   | y == 1 = x * z
-                  | otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)
+                  | otherwise = g (x * x) (y `quot` 2) (x * z) -- See Note [Half of y - 1]
 
 -- | raise a number to an integral power
 (^^)            :: (Fractional a, Integral b) => a -> b -> a
 {-# INLINABLE [1] (^^) #-}         -- See Note [Inlining (^)
 x ^^ n          =  if n >= 0 then x^n else recip (x^(negate n))
 
+{- Note [Half of y - 1]
+   ~~~~~~~~~~~~~~~~~~~~~
+   Since y is guaranteed to be odd and positive here,
+   half of y - 1 can be computed as y `quot` 2, optimising subtraction away.
+-}
+
 {- Note [Inlining (^)
    ~~~~~~~~~~~~~~~~~~~~~
    The INLINABLE pragma allows (^) to be specialised at its call sites.



More information about the ghc-commits mailing list