Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
-
45305ab8
by sheaf at 2025-09-10T10:43:29-04:00
2 changed files:
Changes:
| ... | ... | @@ -4,6 +4,7 @@ |
| 4 | 4 | * Remove deprecated, unstable heap representation details from `GHC.Exts` ([CLC proposal #212](https://github.com/haskell/core-libraries-committee/issues/212))
|
| 5 | 5 | * Add `Data.List.NonEmpty.mapMaybe`. ([CLC proposal #337](https://github.com/haskell/core-libraries-committee/issues/337))
|
| 6 | 6 | * Fix issues with toRational for types capable to represent infinite and not-a-number values ([CLC proposal #338](https://github.com/haskell/core-libraries-committee/issues/338))
|
| 7 | + * Ensure that `rationalToFloat` and `rationalToDouble` always inline in the end. ([CLC proposal #356](https://github.com/haskell/core-libraries-committee/issues/356))
|
|
| 7 | 8 | * Modify the implementation of `Data.List.sortOn` to use `(>)` instead of `compare`. ([CLC proposal #332](https://github.com/haskell/core-libraries-committee/issues/332))
|
| 8 | 9 | * `GHC.Exts.IOPort#` and its related operations have been removed ([CLC #213](https://github.com/haskell/core-libraries-committee/issues/213))
|
| 9 | 10 | * Add `thenA` and `thenM`. ([CLC proposal #351](https://github.com/haskell/core-libraries-committee/issues/351))
|
| ... | ... | @@ -466,8 +466,8 @@ instance Fractional Float where |
| 466 | 466 | recip x = 1.0 / x
|
| 467 | 467 | |
| 468 | 468 | rationalToFloat :: Integer -> Integer -> Float
|
| 469 | -{-# NOINLINE [0] rationalToFloat #-}
|
|
| 470 | --- Re NOINLINE pragma, see Note [realToFrac natural-to-float]
|
|
| 469 | +{-# INLINE [0] rationalToFloat #-}
|
|
| 470 | +-- Re INLINE pragma, see Note [realToFrac natural-to-float]
|
|
| 471 | 471 | rationalToFloat n 0
|
| 472 | 472 | | n == 0 = 0/0
|
| 473 | 473 | | n < 0 = (-1)/0
|
| ... | ... | @@ -718,8 +718,8 @@ instance Fractional Double where |
| 718 | 718 | recip x = 1.0 / x
|
| 719 | 719 | |
| 720 | 720 | rationalToDouble :: Integer -> Integer -> Double
|
| 721 | -{-# NOINLINE [0] rationalToDouble #-}
|
|
| 722 | --- Re NOINLINE pragma, see Note [realToFrac natural-to-float]
|
|
| 721 | +{-# INLINE [0] rationalToDouble #-}
|
|
| 722 | +-- Re INLINE pragma, see Note [realToFrac natural-to-float]
|
|
| 723 | 723 | rationalToDouble n 0
|
| 724 | 724 | | n == 0 = 0/0
|
| 725 | 725 | | n < 0 = (-1)/0
|
| ... | ... | @@ -1673,7 +1673,11 @@ Now we'd have a BUILTIN constant folding rule for rationalToFloat; but |
| 1673 | 1673 | to allow that rule to fire reliably we should delay inlining rationalToFloat
|
| 1674 | 1674 | until stage 0. (It may get an inlining from CPR analysis.)
|
| 1675 | 1675 | |
| 1676 | -Hence the NOINLINE[0] rationalToFloat, and similarly rationalToDouble.
|
|
| 1676 | +Hence the INLINE[0] rationalToFloat, and similarly for rationalToDouble.
|
|
| 1677 | +This activation means:
|
|
| 1678 | + |
|
| 1679 | + - we don't inline until phase 0 (solving the above)
|
|
| 1680 | + - we do inline starting at phase 0 (because we do want it inlining in the end)
|
|
| 1677 | 1681 | -}
|
| 1678 | 1682 | |
| 1679 | 1683 | -- Utils
|