From f6960b188f4e66bb1c7b00d55a015fdd418614a7 Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Tue, 23 Mar 2021 23:27:36 +0000 Subject: Make RULES more robust in GHC.Float The RULES that use hand-written specialised code for overloaded class methods like floor, ceiling, truncate etc were fragile to certain transformations. This patch makes them robust. See #19582. It's all described in Note [Rules for overloaded class methods]. No test case because currently we don't do the transformation (floating out over-saturated applications) that makes this patch have an effect. But we may so so in future, and this patch makes the RULES much more robust. --- libraries/base/GHC/Float.hs | 230 +++++++++++++++++++++++++++++--------------- 1 file changed, 155 insertions(+), 75 deletions(-) (limited to 'libraries') diff --git a/libraries/base/GHC/Float.hs b/libraries/base/GHC/Float.hs index e5ecc94045..acca5118ab 100644 --- a/libraries/base/GHC/Float.hs +++ b/libraries/base/GHC/Float.hs @@ -348,32 +348,66 @@ rationalToFloat n d minEx = FLT_MIN_EXP mantDigs = FLT_MANT_DIG +-- | @since 2.01 +instance RealFrac Float where + + properFraction = properFractionFloat + truncate = truncateFloat + round = roundFloat + floor = floorFloat + ceiling = ceilingFloat + -- RULES for Integer and Int +-- Note [Rules for overloaded class methods] {-# RULES -"properFraction/Float->Integer" properFraction = properFractionFloatInteger -"truncate/Float->Integer" truncate = truncateFloatInteger -"floor/Float->Integer" floor = floorFloatInteger -"ceiling/Float->Integer" ceiling = ceilingFloatInteger -"round/Float->Integer" round = roundFloatInteger -"properFraction/Float->Int" properFraction = properFractionFloatInt -"truncate/Float->Int" truncate = float2Int -"floor/Float->Int" floor = floorFloatInt -"ceiling/Float->Int" ceiling = ceilingFloatInt -"round/Float->Int" round = roundFloatInt +"properFraction/Float->Integer" properFractionFloat = properFractionFloatInteger +"truncate/Float->Integer" truncateFloat = truncateFloatInteger +"floor/Float->Integer" floorFloat = floorFloatInteger +"ceiling/Float->Integer" ceilingFloat = ceilingFloatInteger +"round/Float->Integer" roundFloat = roundFloatInteger +"properFraction/Float->Int" properFractionFloat = properFractionFloatInt +"truncate/Float->Int" truncateFloat = float2Int +"floor/Float->Int" floorFloat = floorFloatInt +"ceiling/Float->Int" ceilingFloat = ceilingFloatInt +"round/Float->Int" roundFloat = roundFloatInt #-} --- | @since 2.01 -instance RealFrac Float where - -- ceiling, floor, and truncate are all small - {-# INLINE [1] ceiling #-} - {-# INLINE [1] floor #-} - {-# INLINE [1] truncate #-} + +floorFloat :: Integral b => Float -> b +{-# INLINE [1] floorFloat #-} +floorFloat x = case properFractionFloat x of + (n,r) -> if r < 0.0 then n - 1 else n + +ceilingFloat :: Integral b => Float -> b +{-# INLINE [1] ceilingFloat #-} +ceilingFloat x = case properFraction x of + (n,r) -> if r > 0.0 then n + 1 else n + +truncateFloat :: Integral b => Float -> b +{-# INLINE [1] truncateFloat #-} +truncateFloat x = case properFractionFloat x of + (n,_) -> n + +roundFloat :: Integral b => Float -> b +{-# NOINLINE [1] roundFloat #-} +roundFloat x = case properFractionFloat x of + (n,r) -> let + m = if r < 0.0 then n - 1 else n + 1 + half_down = abs r - 0.5 + in + case (compare half_down 0.0) of + LT -> n + EQ -> if even n then n else m + GT -> m + +properFractionFloat :: Integral b => Float -> (b,Float) +{-# NOINLINE [1] properFractionFloat #-} -- We assume that FLT_RADIX is 2 so that we can use more efficient code #if FLT_RADIX != 2 #error FLT_RADIX must be 2 #endif - properFraction (F# x#) +properFractionFloat (F# x#) = case decodeFloat_Int# x# of (# m#, n# #) -> let m = I# m# @@ -386,24 +420,7 @@ instance RealFrac Float where f = m - (i `shiftL` negate n) in (fromIntegral i, encodeFloat (fromIntegral f) n) - truncate x = case properFraction x of - (n,_) -> n - round x = case properFraction x of - (n,r) -> let - m = if r < 0.0 then n - 1 else n + 1 - half_down = abs r - 0.5 - in - case (compare half_down 0.0) of - LT -> n - EQ -> if even n then n else m - GT -> m - - ceiling x = case properFraction x of - (n,r) -> if r > 0.0 then n + 1 else n - - floor x = case properFraction x of - (n,r) -> if r < 0.0 then n - 1 else n -- | @since 2.01 instance Floating Float where @@ -585,55 +602,118 @@ instance Floating Double where | otherwise = a {-# INLINE log1pexp #-} +-- | @since 2.01 +instance RealFrac Double where + properFraction = properFractionDouble + truncate = truncateDouble + round = roundDouble + ceiling = ceilingDouble + floor = floorDouble + -- RULES for Integer and Int +-- Note [Rules for overloaded class methods] {-# RULES -"properFraction/Double->Integer" properFraction = properFractionDoubleInteger -"truncate/Double->Integer" truncate = truncateDoubleInteger -"floor/Double->Integer" floor = floorDoubleInteger -"ceiling/Double->Integer" ceiling = ceilingDoubleInteger -"round/Double->Integer" round = roundDoubleInteger -"properFraction/Double->Int" properFraction = properFractionDoubleInt -"truncate/Double->Int" truncate = double2Int -"floor/Double->Int" floor = floorDoubleInt -"ceiling/Double->Int" ceiling = ceilingDoubleInt -"round/Double->Int" round = roundDoubleInt +"properFraction/Double->Integer" properFractionDouble = properFractionDoubleInteger +"truncate/Double->Integer" truncateDouble = truncateDoubleInteger +"floor/Double->Integer" floorDouble = floorDoubleInteger +"ceiling/Double->Integer" ceilingDouble = ceilingDoubleInteger +"round/Double->Integer" roundDouble = roundDoubleInteger +"properFraction/Double->Int" properFractionDouble = properFractionDoubleInt +"truncate/Double->Int" truncateDouble = double2Int +"floor/Double->Int" floorDouble = floorDoubleInt +"ceiling/Double->Int" ceilingDouble = ceilingDoubleInt +"round/Double->Int" roundDouble = roundDoubleInt #-} --- | @since 2.01 -instance RealFrac Double where - -- ceiling, floor, and truncate are all small - {-# INLINE [1] ceiling #-} - {-# INLINE [1] floor #-} - {-# INLINE [1] truncate #-} +floorDouble :: Integral b => Double -> b +{-# INLINE [1] floorDouble #-} +floorDouble x = case properFractionDouble x of + (n,r) -> if r < 0.0 then n - 1 else n - properFraction x - = case (decodeFloat x) of { (m,n) -> - if n >= 0 then - (fromInteger m * 2 ^ n, 0.0) - else - case (quotRem m (2^(negate n))) of { (w,r) -> - (fromInteger w, encodeFloat r n) - } - } +ceilingDouble :: Integral b => Double -> b +{-# INLINE [1] ceilingDouble #-} +ceilingDouble x = case properFractionDouble x of + (n,r) -> if r > 0.0 then n + 1 else n - truncate x = case properFraction x of +truncateDouble :: Integral b => Double -> b +{-# INLINE [1] truncateDouble #-} +truncateDouble x = case properFractionDouble x of (n,_) -> n - round x = case properFraction x of - (n,r) -> let - m = if r < 0.0 then n - 1 else n + 1 - half_down = abs r - 0.5 - in - case (compare half_down 0.0) of - LT -> n - EQ -> if even n then n else m - GT -> m - - ceiling x = case properFraction x of - (n,r) -> if r > 0.0 then n + 1 else n - - floor x = case properFraction x of - (n,r) -> if r < 0.0 then n - 1 else n +roundDouble :: Integral b => Double -> b +{-# NOINLINE [1] roundDouble #-} +roundDouble x + = case properFractionDouble x of + (n,r) -> let + m = if r < 0.0 then n - 1 else n + 1 + half_down = abs r - 0.5 + in + case (compare half_down 0.0) of + LT -> n + EQ -> if even n then n else m + GT -> m + +properFractionDouble :: Integral b => Double -> (b,Double) +{-# NOINLINE [1] properFractionDouble #-} +properFractionDouble x + = case (decodeFloat x) of { (m,n) -> + if n >= 0 then + (fromInteger m * 2 ^ n, 0.0) + else + case (quotRem m (2^(negate n))) of { (w,r) -> + (fromInteger w, encodeFloat r n) + } + } + +{- Note [Rules for overloaded class methods] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a method like + class ... => RealFrac a where + floor :: Integral b => a -> b + +So floor :: forall a. RealFrac a => forall b. Integral b => a -> b + +Now suppose we want to hand-write specialised code for +(floor @Double d1 @Int d2). We used to do this: + RULE "floor/Double->Int" floor = floorDoubleInt +where GHC.Float.RealFracMethods defines + floorDoubleInt :: Double -> Int + +This RULE in full is + RULE "floor/Double->Int" forall d1 d2. + floor @Double d1 @Int d2 = floorDoubleInt + +But it's best not to write one rule for this entire step. I found cases +(in nofib/real/gamteb/Utils.hs, function fiRem) where we floated +out the (floor @Double d1) part, so the above two-argument rule didn't fire. +Instead the class-op rule fired. Boo! See #19582. + +Best to define an instance + instance RealFrac Double where + floor = floorDouble + + floorDouble :: Integral b => Double -> b + floorDouble = + {-# RULE "floorDouble/Int" floorDouble @Int d = floorDoubleInt #-} + +Now we rewrite as follows + floor @Double d1 @Int d2 + --> { ClassOp rule for floor } + floorDouble @Int d2 + --> { Hand-written RULE "floorDouble/Int" } + floorDoubleInt + +More robust! This pattern applies for any class method that +has local overloading, in particular: + * properFraction + * truncate + * floor + * ceiling + * round + +All of this is really stated, in more general form, in the GHC +user manual section "How rules interact with class methods". +-} -- | @since 2.01 instance RealFloat Double where -- cgit v1.2.1