Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ffa56ae4 by sheaf at 2026-10-09T17:15:59+02:00 Preserve sign of zero when parsing -0.0# This commit leverages the recently added GHC.Types.Literal.Floating module in order to preserve the sign of negative zero from source-written floating-point literals. Fixes #27545 - - - - - 8 changed files: - + changelog.d/T27545 - compiler/GHC/Core/Make.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/Language/Haskell/Syntax/Lit.hs - + testsuite/tests/numeric/should_run/T27545.hs - + testsuite/tests/numeric/should_run/T27545.stdout - testsuite/tests/numeric/should_run/all.T Changes: ===================================== changelog.d/T27545 ===================================== @@ -0,0 +1,8 @@ +section: compiler +issues: #27545 +mrs: !16405 +synopsis: + Source-written `-0.0#` floating-point literals preserve their sign. +description: + GHC now preserves the sign of zero in source-written unboxed floating-point + literals. ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -277,15 +277,13 @@ mkNaturalExpr platform w | platformInWordRange platform w = mkCoreConApps naturalNSDataCon [mkWordLit platform w] | otherwise = mkCoreConApps naturalNBDataCon [Lit (mkLitBigNat w)] --- | Create a 'CoreExpr' which will evaluate to a --- (lifted) @Float@ approximating the given @Rational@ -mkFloatExpr :: Rational -> CoreExpr -mkFloatExpr r = mkCoreConApps floatDataCon [mkFloatLit r] - --- | Create a 'CoreExpr' which will evaluate to a --- (lifted) @Double@ approximating the given @Rational@ -mkDoubleExpr :: Rational -> CoreExpr -mkDoubleExpr r = mkCoreConApps doubleDataCon [mkDoubleLit r] +-- | Create a lifted @Float@ expression from a floating-point literal. +mkFloatExpr :: LitFloating -> CoreExpr +mkFloatExpr f = mkCoreConApps floatDataCon [Lit (LitFloating LitFloat f)] + +-- | Create a lifted @Double@ expression from a floating-point literal. +mkDoubleExpr :: LitFloating -> CoreExpr +mkDoubleExpr d = mkCoreConApps doubleDataCon [Lit (LitFloating LitDouble d)] -- | Create a 'CoreExpr' which will evaluate to the given @Char@ ===================================== compiler/GHC/Hs/Lit.hs ===================================== @@ -58,6 +58,7 @@ module GHC.Hs.Lit ( , mkTHFractionalLit -- *** Conversion , rationalFromFractionalLit + , litFloatingFromFractionalLit , negateFractionalLit , rnFractionalLit , tcFractionalLit @@ -96,6 +97,9 @@ import GHC.Data.FastString import GHC.Types.Basic (PprPrec(..), topPrec ) import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} ) import GHC.Types.SourceText +import GHC.Types.Literal.Floating + ( LitFloating, LitFloatingType(..), ConstantFoldingPrecision(..) + , floatToLitFloating, doubleToLitFloating, litRationalToFloatOp ) import GHC.Core.Type import GHC.Utils.Misc (split) import GHC.Utils.Outputable @@ -578,14 +582,37 @@ negateFractionalLit (FL text neg i e eb) = case text of SourceText src -> FL (SourceText ('-' `consFS` src)) True (negate i) e eb NoSourceText -> FL NoSourceText (not neg) (negate i) e eb +-- | __Warning__: discards the sign of @-0.0@. +-- +-- Prefer using 'litFloatingFromFractionalLit' when possible. rationalFromFractionalLit :: FractionalLit (GhcPass p) -> Rational rationalFromFractionalLit (FL _ _ i e expBase) = mkRationalWithExponentBase i e expBase +-- | The exact value of a fractional literal as a rational number: +-- @significand * base ^^ exponent@. +-- +-- See Note [fractional exponent bases] in Language.Haskell.Syntax.Lit. mkRationalWithExponentBase :: Rational -> Integer -> FractionalExponentBase -> Rational mkRationalWithExponentBase i e feb = i * (eb ^^ e) where eb = case feb of Base2 -> 2 ; Base10 -> 10 +-- | Convert a source fractional literal to a 'LitFloating'. +-- +-- Preserves the sign of zero. NaNs and infinities have no source syntax so +-- they are not a concern here. +litFloatingFromFractionalLit :: LitFloatingType -> FractionalLit (GhcPass p) -> LitFloating +litFloatingFromFractionalLit ty fl + | fl_signi fl == 0 + = case ty of + LitFloat -> floatToLitFloating $ if fl_neg fl then -0 else 0 + LitDouble -> doubleToLitFloating $ if fl_neg fl then -0 else 0 + | otherwise + = litRationalToFloatOp prec (rationalFromFractionalLit fl) + where + prec = case ty of + LitFloat -> FloatPrecision + LitDouble -> DoublePrecision -- For internal use only. DO NOT EXPORT! convertFractionalLit :: FractionalLit (GhcPass p) -> FractionalLit (GhcPass p') ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -115,12 +115,12 @@ dsLit l = do -- This can be slow for very large literals. See Note [FractionalLit representation] -- and #15646 - HsFloatPrim _ fl -> return (mkFloatLit (rationalFromFractionalLit fl)) - HsDoublePrim _ fl -> return (mkDoubleLit (rationalFromFractionalLit fl)) + HsFloatPrim _ fl -> return (Lit (mkFloatingPrimLit LitFloat fl)) + HsDoublePrim _ fl -> return (Lit (mkFloatingPrimLit LitDouble fl)) HsChar _ c -> return (mkCharExpr c) HsString _ str -> (`mkStringExprFSWith` mkFastStringShortText str) <$> getMkStringIds dsLookupKnownKeyId HsNatural _ i -> return (mkNaturalExpr platform (il_value i)) - HsDouble _ fl -> return (mkDoubleExpr (fromRational (rationalFromFractionalLit fl))) + HsDouble _ fl -> return (mkDoubleExpr (litFloatingFromFractionalLit LitDouble fl)) HsInt _ i -> return (mkIntExpr platform (il_value i)) XLit x -> case ghcPass @p of GhcTc -> case x of @@ -237,6 +237,10 @@ dsFractionalLitToRational fl@FL{ fl_signi = signi, fl_exp = exp, fl_exp_base = b let litE = mkIntegerExpr platform exp return (mkCoreApps (Var mkRational) [litR, litE]) +-- | The @Float#@\/@Double#@ Core 'Literal' for a source 'FractionalLit'. +mkFloatingPrimLit :: LitFloatingType -> FractionalLit (GhcPass p) -> Literal +mkFloatingPrimLit ty fl = LitFloating ty (litFloatingFromFractionalLit ty fl) + dsRational :: Rational -> DsM CoreExpr dsRational (n :% d) = do platform <- targetPlatform <$> getDynFlags @@ -664,8 +668,8 @@ hsLitKey _ (HsWord32Prim _ w) = mkLitWord32Wrap w hsLitKey _ (HsWord64Prim _ w) = mkLitWord64Wrap w hsLitKey _ (HsCharPrim _ c) = mkLitChar c -- This following two can be slow. See Note [FractionalLit representation] -hsLitKey _ (HsFloatPrim _ fl) = mkLitFloat (rationalFromFractionalLit fl) -hsLitKey _ (HsDoublePrim _ fl) = mkLitDouble (rationalFromFractionalLit fl) +hsLitKey _ (HsFloatPrim _ fl) = mkFloatingPrimLit LitFloat fl +hsLitKey _ (HsDoublePrim _ fl) = mkFloatingPrimLit LitDouble fl hsLitKey _ (HsString _ s) = LitString (bytesHText s) hsLitKey _ l = pprPanic "hsLitKey" (ppr l) ===================================== compiler/Language/Haskell/Syntax/Lit.hs ===================================== @@ -149,7 +149,7 @@ data QualLitVal p -- denotes -5300 data FractionalLit pass = FL - { fl_text :: XFractionalLit pass + { fl_text :: XFractionalLit pass , fl_neg :: Bool -- See Note [Negative zero] , fl_signi :: Rational -- The significand component of the literal , fl_exp :: Integer -- The exponent component of the literal ===================================== testsuite/tests/numeric/should_run/T27545.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE MagicHash, NegativeLiterals #-} + +import GHC.Exts +import GHC.Word +import Numeric + +main :: IO () +main = do + putStrLn $ " 0.0# bits = 0x" ++ showHex (W32# (castFloatToWord32# 0.0# )) "" + putStrLn $ "-0.0# bits = 0x" ++ showHex (W32# (castFloatToWord32# -0.0# )) "" + putStrLn $ " 0.0## bits = 0x" ++ showHex (W64# (castDoubleToWord64# 0.0##)) "" + putStrLn $ "-0.0## bits = 0x" ++ showHex (W64# (castDoubleToWord64# -0.0##)) "" ===================================== testsuite/tests/numeric/should_run/T27545.stdout ===================================== @@ -0,0 +1,4 @@ + 0.0# bits = 0x0 +-0.0# bits = 0x80000000 + 0.0## bits = 0x0 +-0.0## bits = 0x8000000000000000 ===================================== testsuite/tests/numeric/should_run/all.T ===================================== @@ -80,6 +80,7 @@ test('T18509', normal, compile_and_run, ['']) test('T18515', normal, compile_and_run, ['']) test('T18604', normal, compile_and_run, ['']) test('T19931', normal, compile_and_run, ['-O2']) +test('T27545', normal, compile_and_run, ['']) test('IntegerToFloat', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ffa56ae4b4c2e207cb9584bf718f27eb... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ffa56ae4b4c2e207cb9584bf718f27eb... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help