Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 477b1e42 by Andrew Lelechenko at 2025-07-22T16:03:00-04:00 Fix issues with toRational for types capable to represent infinite and not-a-number values This commit fixes all of the following pitfalls:
toRational (read "Infinity" :: Double) 179769313486231590772930519078902473361797697894230657273430081157732675805500963132708477322407536021120113879871393357658789768814416622492847430639474124377767893424865485276302219601246094119453082952085005768838150682342462881473913110540827237163350510684586298239947245938479716304835356329624224137216 % 1 toRational (read "NaN" :: Double) 269653970229347386159395778618353710042696546841345985910145121736599013708251444699062715983611304031680170819807090036488184653221624933739271145959211186566651840137298227914453329401869141179179624428127508653257226023513694322210869665811240855745025766026879447359920868907719574457253034494436336205824 % 1
realToFrac (read "NaN" :: Double) -- With -O0 Infinity realToFrac (read "NaN" :: Double) -- With -O1 NaN
realToFrac (read "NaN" :: Double) :: CDouble Infinity realToFrac (read "NaN" :: CDouble) :: Double Infinity
Implements https://github.com/haskell/core-libraries-committee/issues/338 - - - - - d70620a5 by Zubin Duggal at 2025-07-22T16:03:01-04:00 haddock: Don't warn about missing link destinations for derived names. Fixes #26114 - - - - - 70668033 by Matthew Pickering at 2025-07-22T16:03:02-04:00 template haskell: use a precise condition when implicitly lifting Implicit lifting corrects a level error by replacing references to `x` with `$(lift x)`, therefore you can use a level `n` binding at level `n + 1`, if it can be lifted. Therefore, we now have a precise check that the use level is 1 more than the bind level. Before this bug was not observable as you only had 0 and 1 contexts but it is easily evident when using explicit level imports. Fixes #26088 - - - - - 5bfd76e1 by Andreas Klebinger at 2025-07-22T16:03:03-04:00 Add since tag and more docs for do-clever-arg-eta-expansion Fixes #26113 - - - - - 9359f9a4 by Andreas Klebinger at 2025-07-22T16:03:03-04:00 Add since tag for -fexpose-overloaded-unfoldings Fixes #26112 - - - - - 15 changed files: - compiler/GHC/Rename/Splice.hs - docs/users_guide/using-optimisation.rst - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Float.hs - libraries/ghc-internal/src/GHC/Internal/Real.hs - testsuite/tests/haddock/haddock_testsuite/Makefile - + testsuite/tests/haddock/haddock_testsuite/T26114.hs - + testsuite/tests/haddock/haddock_testsuite/T26114.stdout - testsuite/tests/haddock/haddock_testsuite/all.T - testsuite/tests/numeric/should_run/T9810.stdout - + testsuite/tests/splice-imports/T26088.stderr - + testsuite/tests/splice-imports/T26088A.hs - + testsuite/tests/splice-imports/T26088B.hs - testsuite/tests/splice-imports/all.T - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs Changes: ===================================== compiler/GHC/Rename/Splice.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Rename.Pat ( rnPat ) import GHC.Types.Error import GHC.Types.Basic ( TopLevelFlag, isTopLevel, maxPrec ) import GHC.Types.SourceText ( SourceText(..) ) +import GHC.Types.ThLevelIndex import GHC.Utils.Outputable import GHC.Unit.Module import GHC.Types.SrcLoc @@ -1001,7 +1002,7 @@ checkCrossLevelLifting dflags reason top_lvl is_local allow_lifting bind_lvl use , xopt LangExt.ImplicitStagePersistence dflags = when (isExternalName name) (keepAlive name) >> return (HsVar noExtField name_var) -- 4. Name is in a bracket, and lifting is allowed | Brack _ pending <- use_lvl - , any (use_lvl_idx >=) (Set.toList bind_lvl) + , any (\bind_idx -> use_lvl_idx == incThLevelIndex bind_idx) (Set.toList bind_lvl) , allow_lifting = do let mgre = case reason of ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -547,16 +547,24 @@ as such you shouldn't need to set any of them explicitly. A flag Eta-expand let-bindings to increase their arity. .. ghc-flag:: -fdo-clever-arg-eta-expansion - :shortdesc: Enable sophisticated argument eta-expansion. Implied by :ghc-flag:`-O2`. + :shortdesc: Enable sophisticated argument eta-expansion. Implied by :ghc-flag:`-O`. :type: dynamic :reverse: -fno-do-clever-arg-eta-expansion :category: :default: off + :since: 9.10.1 Eta-expand arguments to increase their arity to avoid allocating unnecessary thunks for them. + For example in code like `foo = f (g x)` this flag will determine which analysis + is used to decide the arity of `g x`, with the goal of avoiding a thunk for `g x` + in cases where `g` is a function with an arity higher than one. + + Enabling the flag enables a more sophisticated analysis, resulting in better + runtime but longer compile time. + .. ghc-flag:: -feager-blackholing :shortdesc: Turn on :ref:`eager blackholing <parallel-compile-options>` :type: dynamic @@ -617,6 +625,7 @@ as such you shouldn't need to set any of them explicitly. A flag :category: :default: off + :since: 9.12.1 This experimental flag is a slightly less heavy weight alternative to :ghc-flag:`-fexpose-all-unfoldings`. ===================================== libraries/base/changelog.md ===================================== @@ -2,6 +2,7 @@ ## 4.23.0.0 *TBA* * Add `Data.List.NonEmpty.mapMaybe`. ([CLC proposal #337](https://github.com/haskell/core-libraries-committee/issues/337)) + * 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)) ## 4.22.0.0 *TBA* * Shipped with GHC 9.14.1 ===================================== libraries/ghc-internal/src/GHC/Internal/Float.hs ===================================== @@ -430,14 +430,10 @@ naturalToFloat# (NB b) = case integerToBinaryFloat' (IP b) of -- | @since base-2.01 -- --- Beware that 'toRational' generates garbage for non-finite arguments: --- --- >>> toRational (1/0 :: Float) --- 340282366920938463463374607431768211456 % 1 --- >>> toRational (0/0 :: Float) --- 510423550381407695195061911147652317184 % 1 --- instance Real Float where + toRational x + | isInfinite x = if x > 0 then infinity else -infinity + | isNaN x = notANumber toRational (F# x#) = case decodeFloat_Int# x# of (# m#, e# #) @@ -686,14 +682,10 @@ naturalToDouble# (NB b) = case integerToBinaryFloat' (IP b) of -- | @since base-2.01 -- --- Beware that 'toRational' generates garbage for non-finite arguments: --- --- >>> toRational (1/0) --- 179769313 (and 300 more digits...) % 1 --- >>> toRational (0/0) --- 269653970 (and 300 more digits...) % 1 --- instance Real Double where + toRational x + | isInfinite x = if x > 0 then infinity else -infinity + | isNaN x = notANumber toRational (D# x#) = case integerDecodeDouble# x# of (# m, e# #) ===================================== libraries/ghc-internal/src/GHC/Internal/Real.hs ===================================== @@ -703,15 +703,6 @@ fromIntegral = fromInteger . toInteger -- | General coercion to 'Fractional' types. -- --- WARNING: This function goes through the 'Rational' type, which does not have values for 'NaN' for example. --- This means it does not round-trip. --- --- For 'Double' it also behaves differently with or without -O0: --- --- > Prelude> realToFrac nan -- With -O0 --- > -Infinity --- > Prelude> realToFrac nan --- > NaN realToFrac :: (Real a, Fractional b) => a -> b {-# NOINLINE [1] realToFrac #-} -- See Note [Allow time for type-specialisation rules to fire] ===================================== testsuite/tests/haddock/haddock_testsuite/Makefile ===================================== @@ -76,3 +76,7 @@ hypsrcTest: .PHONY: haddockForeignTest haddockForeignTest: '$(HADDOCK)' A.hs B.hs F.hs arith.c + +.PHONY: T26114 +T26114: + '$(HADDOCK)' T26114.hs ===================================== testsuite/tests/haddock/haddock_testsuite/T26114.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE TypeFamilies #-} + +-- | Module +module T26114 where + +-- | C1 +class C1 t where + type C2 t + +-- | A +data A = A + +instance C1 A where + type C2 A = B + +-- | B +data B = B + +instance C1 B where + type C2 B = C + +-- | C +data C = C ===================================== testsuite/tests/haddock/haddock_testsuite/T26114.stdout ===================================== @@ -0,0 +1,3 @@ +[1 of 1] Compiling T26114 ( T26114.hs, nothing ) +Haddock coverage: + 100% ( 5 / 5) in 'T26114' ===================================== testsuite/tests/haddock/haddock_testsuite/all.T ===================================== @@ -24,3 +24,8 @@ test('haddockForeignTest', [ignore_stdout, ignore_stderr, req_haddock, extra_files(['./haddock-th-foreign-repro/A.hs', './haddock-th-foreign-repro/B.hs', './haddock-th-foreign-repro/F.hs', './haddock-th-foreign-repro/arith.c'])], makefile_test, ['haddockForeignTest']) + +test('T26114', + [ignore_stderr, req_haddock, extra_files(['T26114.hs'])], + makefile_test, + ['T26114']) ===================================== testsuite/tests/numeric/should_run/T9810.stdout ===================================== @@ -1,14 +1,14 @@ ## Double ## Infinity -Infinity -Infinity +NaN Infinity -Infinity Infinity ## Float ## Infinity -Infinity -Infinity +NaN Infinity -Infinity Infinity ===================================== testsuite/tests/splice-imports/T26088.stderr ===================================== @@ -0,0 +1,6 @@ +T26088A.hs:8:8: error: [GHC-28914] + • Level error: ‘a’ is bound at level -1 but used at level 1 + • Available from the imports: + • imported from ‘T26088B’ at -1 at T26088A.hs:4:1-21 + • In the Template Haskell quotation: [| a |] + ===================================== testsuite/tests/splice-imports/T26088A.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE ExplicitLevelImports, TemplateHaskell #-} +module T26088A where + +import splice T26088B +import Language.Haskell.TH.Syntax + +x :: Q Exp +x = [| a |] ===================================== testsuite/tests/splice-imports/T26088B.hs ===================================== @@ -0,0 +1,3 @@ +module T26088B where + +a = () ===================================== testsuite/tests/splice-imports/all.T ===================================== @@ -47,3 +47,4 @@ test('SI35', ['-package ghc']) test('SI36', [extra_files(["SI36_A.hs", "SI36_B1.hs", "SI36_B2.hs", "SI36_B3.hs", "SI36_C1.hs", "SI36_C2.hs", "SI36_C3.hs"])], multimod_compile_fail, ['SI36', '-v0']) test('T26087', [], multimod_compile_fail, ['T26087A', '']) +test('T26088', [], multimod_compile_fail, ['T26088A', '-v0']) ===================================== utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs ===================================== @@ -110,6 +110,7 @@ renameInterface ignoreSet renamingEnv expInfo warnings hoogle iface = do && isExternalName name && not (isBuiltInSyntax name) && not (isTyVarName name) + && not (isDerivedOccName $ nameOccName name) && Exact name /= eqTyCon_RDR -- Must not be in the set of ignored symbols for the module or the -- unqualified ignored symbols View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f86eda911a3702097f1db29f6d1330... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f86eda911a3702097f1db29f6d1330... You're receiving this email because of your account on gitlab.haskell.org.