Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

8 changed files:

Changes:

  • changelog.d/T27545
    1 
    +section: compiler
    2 
    +issues: #27545
    3 
    +mrs: !16405
    4 
    +synopsis:
    5 
    +  Source-written `-0.0#` floating-point literals preserve their sign.
    6 
    +description:
    7 
    +  GHC now preserves the sign of zero in source-written unboxed floating-point
    8 
    +  literals.

  • compiler/GHC/Core/Make.hs
    ... ... @@ -277,15 +277,13 @@ mkNaturalExpr platform w
    277 277 
       | platformInWordRange platform w = mkCoreConApps naturalNSDataCon [mkWordLit platform w]
    278 278 
       | otherwise                      = mkCoreConApps naturalNBDataCon [Lit (mkLitBigNat w)]
    279 279
    280 
    --- | Create a 'CoreExpr' which will evaluate to a
    281 
    --- (lifted) @Float@ approximating the given @Rational@
    282 
    -mkFloatExpr  :: Rational -> CoreExpr
    283 
    -mkFloatExpr  r = mkCoreConApps floatDataCon  [mkFloatLit  r]
    284 
    -
    285 
    --- | Create a 'CoreExpr' which will evaluate to a
    286 
    --- (lifted) @Double@ approximating the given @Rational@
    287 
    -mkDoubleExpr :: Rational -> CoreExpr
    288 
    -mkDoubleExpr r = mkCoreConApps doubleDataCon [mkDoubleLit r]
    280 
    +-- | Create a lifted @Float@ expression from a floating-point literal.
    281 
    +mkFloatExpr  :: LitFloating -> CoreExpr
    282 
    +mkFloatExpr  f = mkCoreConApps floatDataCon  [Lit (LitFloating LitFloat  f)]
    283 
    +
    284 
    +-- | Create a lifted @Double@ expression from a floating-point literal.
    285 
    +mkDoubleExpr :: LitFloating -> CoreExpr
    286 
    +mkDoubleExpr d = mkCoreConApps doubleDataCon [Lit (LitFloating LitDouble d)]
    289 287
    290 288
    291 289 
     -- | Create a 'CoreExpr' which will evaluate to the given @Char@

  • compiler/GHC/Hs/Lit.hs
    ... ... @@ -58,6 +58,7 @@ module GHC.Hs.Lit (
    58 58 
       , mkTHFractionalLit
    59 59 
       -- *** Conversion
    60 60 
       , rationalFromFractionalLit
    61 
    +  , litFloatingFromFractionalLit
    61 62 
       , negateFractionalLit
    62 63 
       , rnFractionalLit
    63 64 
       , tcFractionalLit
    ... ... @@ -96,6 +97,9 @@ import GHC.Data.FastString
    96 97 
     import GHC.Types.Basic (PprPrec(..), topPrec )
    97 98 
     import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} )
    98 99 
     import GHC.Types.SourceText
    100 
    +import GHC.Types.Literal.Floating
    101 
    +  ( LitFloating, LitFloatingType(..), ConstantFoldingPrecision(..)
    102 
    +  , floatToLitFloating, doubleToLitFloating, litRationalToFloatOp )
    99 103 
     import GHC.Core.Type
    100 104 
     import GHC.Utils.Misc (split)
    101 105 
     import GHC.Utils.Outputable
    ... ... @@ -578,14 +582,37 @@ negateFractionalLit (FL text neg i e eb) = case text of
    578 582 
       SourceText      src  -> FL (SourceText ('-' `consFS` src)) True  (negate i) e eb
    579 583 
       NoSourceText         -> FL NoSourceText (not neg) (negate i) e eb
    580 584
    585 
    +-- | __Warning__: discards the sign of @-0.0@.
    586 
    +--
    587 
    +-- Prefer using 'litFloatingFromFractionalLit' when possible.
    581 588 
     rationalFromFractionalLit :: FractionalLit (GhcPass p) -> Rational
    582 589 
     rationalFromFractionalLit (FL _ _ i e expBase) =
    583 590 
       mkRationalWithExponentBase i e expBase
    584 591
    592 
    +-- | The exact value of a fractional literal as a rational number:
    593 
    +-- @significand * base ^^ exponent@.
    594 
    +--
    595 
    +-- See Note [fractional exponent bases] in Language.Haskell.Syntax.Lit.
    585 596 
     mkRationalWithExponentBase :: Rational -> Integer -> FractionalExponentBase -> Rational
    586 597 
     mkRationalWithExponentBase i e feb = i * (eb ^^ e)
    587 598 
       where eb = case feb of Base2 -> 2 ; Base10 -> 10
    588 599
    600 
    +-- | Convert a source fractional literal to a 'LitFloating'.
    601 
    +--
    602 
    +-- Preserves the sign of zero. NaNs and infinities have no source syntax so
    603 
    +-- they are not a concern here.
    604 
    +litFloatingFromFractionalLit :: LitFloatingType -> FractionalLit (GhcPass p) -> LitFloating
    605 
    +litFloatingFromFractionalLit ty fl
    606 
    +  | fl_signi fl == 0
    607 
    +  = case ty of
    608 
    +      LitFloat  -> floatToLitFloating  $ if fl_neg fl then -0 else 0
    609 
    +      LitDouble -> doubleToLitFloating $ if fl_neg fl then -0 else 0
    610 
    +  | otherwise
    611 
    +  = litRationalToFloatOp prec (rationalFromFractionalLit fl)
    612 
    +  where
    613 
    +    prec = case ty of
    614 
    +      LitFloat  -> FloatPrecision
    615 
    +      LitDouble -> DoublePrecision
    589 616
    590 617 
     -- For internal use only. DO NOT EXPORT!
    591 618 
     convertFractionalLit :: FractionalLit (GhcPass p) -> FractionalLit (GhcPass p')

  • compiler/GHC/HsToCore/Match/Literal.hs
    ... ... @@ -115,12 +115,12 @@ dsLit l = do
    115 115
    116 116 
         -- This can be slow for very large literals. See Note [FractionalLit representation]
    117 117 
         -- and #15646
    118 
    -    HsFloatPrim  _ fl -> return (mkFloatLit  (rationalFromFractionalLit fl))
    119 
    -    HsDoublePrim _ fl -> return (mkDoubleLit (rationalFromFractionalLit fl))
    118 
    +    HsFloatPrim  _ fl -> return (Lit (mkFloatingPrimLit LitFloat  fl))
    119 
    +    HsDoublePrim _ fl -> return (Lit (mkFloatingPrimLit LitDouble fl))
    120 120 
         HsChar _ c       -> return (mkCharExpr c)
    121 121 
         HsString _ str   -> (`mkStringExprFSWith` mkFastStringShortText str) <$> getMkStringIds dsLookupKnownKeyId
    122 122 
         HsNatural _ i    -> return (mkNaturalExpr platform (il_value i))
    123 
    -    HsDouble _ fl    -> return (mkDoubleExpr (fromRational (rationalFromFractionalLit fl)))
    123 
    +    HsDouble _ fl    -> return (mkDoubleExpr (litFloatingFromFractionalLit LitDouble fl))
    124 124 
         HsInt _ i        -> return (mkIntExpr platform (il_value i))
    125 125 
         XLit x           -> case ghcPass @p of
    126 126 
           GhcTc          -> case x of
    ... ... @@ -237,6 +237,10 @@ dsFractionalLitToRational fl@FL{ fl_signi = signi, fl_exp = exp, fl_exp_base = b
    237 237 
           let litE = mkIntegerExpr platform exp
    238 238 
           return (mkCoreApps (Var mkRational) [litR, litE])
    239 239
    240 
    +-- | The @Float#@\/@Double#@ Core 'Literal' for a source 'FractionalLit'.
    241 
    +mkFloatingPrimLit :: LitFloatingType -> FractionalLit (GhcPass p) -> Literal
    242 
    +mkFloatingPrimLit ty fl = LitFloating ty (litFloatingFromFractionalLit ty fl)
    243 
    +
    240 244 
     dsRational :: Rational -> DsM CoreExpr
    241 245 
     dsRational (n :% d) = do
    242 246 
       platform <- targetPlatform <$> getDynFlags
    ... ... @@ -664,8 +668,8 @@ hsLitKey _ (HsWord32Prim _ w) = mkLitWord32Wrap w
    664 668 
     hsLitKey _        (HsWord64Prim _ w)  = mkLitWord64Wrap w
    665 669 
     hsLitKey _        (HsCharPrim   _ c)  = mkLitChar            c
    666 670 
     -- This following two can be slow. See Note [FractionalLit representation]
    667 
    -hsLitKey _        (HsFloatPrim  _ fl) = mkLitFloat (rationalFromFractionalLit fl)
    668 
    -hsLitKey _        (HsDoublePrim _ fl) = mkLitDouble (rationalFromFractionalLit fl)
    671 
    +hsLitKey _        (HsFloatPrim  _ fl) = mkFloatingPrimLit LitFloat  fl
    672 
    +hsLitKey _        (HsDoublePrim _ fl) = mkFloatingPrimLit LitDouble fl
    669 673
    670 674 
     hsLitKey _        (HsString _ s)      = LitString (bytesHText s)
    671 675 
     hsLitKey _        l                   = pprPanic "hsLitKey" (ppr l)

  • compiler/Language/Haskell/Syntax/Lit.hs
    ... ... @@ -149,7 +149,7 @@ data QualLitVal p
    149 149 
     -- denotes  -5300
    150 150
    151 151 
     data FractionalLit pass = FL
    152 
    -  { fl_text      :: XFractionalLit pass
    152 
    +  { fl_text     :: XFractionalLit pass
    153 153 
       , fl_neg      :: Bool                   -- See Note [Negative zero]
    154 154 
       , fl_signi    :: Rational               -- The significand component of the literal
    155 155 
       , fl_exp      :: Integer                -- The exponent component of the literal

  • testsuite/tests/numeric/should_run/T27545.hs
    1 
    +{-# LANGUAGE MagicHash, NegativeLiterals #-}
    2 
    +
    3 
    +import GHC.Exts
    4 
    +import GHC.Word
    5 
    +import Numeric
    6 
    +
    7 
    +main :: IO ()
    8 
    +main = do
    9 
    +  putStrLn $ " 0.0#  bits = 0x" ++ showHex (W32# (castFloatToWord32#   0.0# )) ""
    10 
    +  putStrLn $ "-0.0#  bits = 0x" ++ showHex (W32# (castFloatToWord32#  -0.0# )) ""
    11 
    +  putStrLn $ " 0.0## bits = 0x" ++ showHex (W64# (castDoubleToWord64#  0.0##)) ""
    12 
    +  putStrLn $ "-0.0## bits = 0x" ++ showHex (W64# (castDoubleToWord64# -0.0##)) ""

  • testsuite/tests/numeric/should_run/T27545.stdout
    1 
    + 0.0#  bits = 0x0
    2 
    +-0.0#  bits = 0x80000000
    3 
    + 0.0## bits = 0x0
    4 
    +-0.0## bits = 0x8000000000000000

  • testsuite/tests/numeric/should_run/all.T
    ... ... @@ -80,6 +80,7 @@ test('T18509', normal, compile_and_run, [''])
    80 80 
     test('T18515', normal, compile_and_run, [''])
    81 81 
     test('T18604', normal, compile_and_run, [''])
    82 82 
     test('T19931', normal, compile_and_run, ['-O2'])
    83 
    +test('T27545', normal, compile_and_run, [''])
    83 84
    84 85 
     test('IntegerToFloat', normal, compile_and_run, [''])
    85 86

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/ffa56ae4b4c2e207cb9584bf718f27eb3979716a at 1791591950