[Git][ghc/ghc][master] 4 commits: Make cast between words and floats real primops (#24331)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sat Feb 17 11:02:25 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
97d26206 by Sylvain Henry at 2024-02-17T06:01:44-05:00
Make cast between words and floats real primops (#24331)
First step towards fixing #24331. Replace foreign prim imports with real
primops.
- - - - -
a40e4781 by Sylvain Henry at 2024-02-17T06:01:44-05:00
Perf: add constant folding for bitcast between float and word (#24331)
- - - - -
5fd2c00f by Sylvain Henry at 2024-02-17T06:01:44-05:00
Perf: replace stack checks with assertions in casting primops
There are RESERVED_STACK_WORDS free words (currently 21) on the stack,
so omit the checks.
Suggested by Cheng Shao.
- - - - -
401dfe7b by Sylvain Henry at 2024-02-17T06:01:44-05:00
Reexport primops from GHC.Float + add deprecation
- - - - -
19 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Core.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Prim.hs
- − libraries/ghc-internal/cbits/CastFloatWord.cmm
- libraries/ghc-internal/ghc-internal.cabal
- libraries/ghc-internal/src/GHC/Float.hs
- rts/PrimOps.cmm
- rts/RtsSymbols.c
- rts/include/stg/MiscClosures.h
- rts/js/arith.js
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- + testsuite/tests/numeric/should_compile/T24331.hs
- + testsuite/tests/numeric/should_compile/T24331.stderr
- testsuite/tests/numeric/should_compile/all.T
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -1231,6 +1231,14 @@ primop DoubleDecode_Int64Op "decodeDouble_Int64#" GenPrimOp
{Decode 'Double#' into mantissa and base-2 exponent.}
with out_of_line = True
+primop CastDoubleToWord64Op "castDoubleToWord64#" GenPrimOp
+ Double# -> Word64#
+ {Bitcast a 'Double#' into a 'Word64#'}
+
+primop CastWord64ToDoubleOp "castWord64ToDouble#" GenPrimOp
+ Word64# -> Double#
+ {Bitcast a 'Word64#' into a 'Double#'}
+
------------------------------------------------------------------------
section "Float#"
{Operations on single-precision (32-bit) floating-point numbers.}
@@ -1377,6 +1385,14 @@ primop FloatDecode_IntOp "decodeFloat_Int#" GenPrimOp
First 'Int#' in result is the mantissa; second is the exponent.}
with out_of_line = True
+primop CastFloatToWord32Op "castFloatToWord32#" GenPrimOp
+ Float# -> Word32#
+ {Bitcast a 'Float#' into a 'Word32#'}
+
+primop CastWord32ToFloatOp "castWord32ToFloat#" GenPrimOp
+ Word32# -> Float#
+ {Bitcast a 'Word32#' into a 'Float#'}
+
------------------------------------------------------------------------
section "Fused multiply-add operations"
{ #fma#
=====================================
compiler/GHC/Core.hs
=====================================
@@ -25,7 +25,7 @@ module GHC.Core (
mkIntLit, mkIntLitWrap,
mkWordLit, mkWordLitWrap,
mkWord8Lit,
- mkWord64LitWord64, mkInt64LitInt64,
+ mkWord32LitWord32, mkWord64LitWord64, mkInt64LitInt64,
mkCharLit, mkStringLit,
mkFloatLit, mkFloatLitFloat,
mkDoubleLit, mkDoubleLitDouble,
@@ -1901,6 +1901,9 @@ mkWordLitWrap platform w = Lit (mkLitWordWrap platform w)
mkWord8Lit :: Integer -> Expr b
mkWord8Lit w = Lit (mkLitWord8 w)
+mkWord32LitWord32 :: Word32 -> Expr b
+mkWord32LitWord32 w = Lit (mkLitWord32 (toInteger w))
+
mkWord64LitWord64 :: Word64 -> Expr b
mkWord64LitWord64 w = Lit (mkLitWord64 (toInteger w))
=====================================
compiler/GHC/Core/Opt/ConstantFold.hs
=====================================
@@ -34,6 +34,7 @@ where
import GHC.Prelude
import GHC.Platform
+import GHC.Float
import GHC.Types.Id.Make ( unboxedUnitExpr )
import GHC.Types.Id
@@ -657,6 +658,38 @@ primOpRules nm = \case
, removeOp32
, narrowSubsumesAnd WordAndOp Narrow32WordOp 32 ]
+ CastWord64ToDoubleOp -> mkPrimOpRule nm 1
+ [ unaryLit $ \_env -> \case
+ LitNumber _ n
+ | v <- castWord64ToDouble (fromInteger n)
+ -- we can't represent those float literals in Core until #18897 is fixed
+ , not (isNaN v || isInfinite v || isNegativeZero v)
+ -> Just (mkDoubleLitDouble v)
+ _ -> Nothing
+ ]
+
+ CastWord32ToFloatOp -> mkPrimOpRule nm 1
+ [ unaryLit $ \_env -> \case
+ LitNumber _ n
+ | v <- castWord32ToFloat (fromInteger n)
+ -- we can't represent those float literals in Core until #18897 is fixed
+ , not (isNaN v || isInfinite v || isNegativeZero v)
+ -> Just (mkFloatLitFloat v)
+ _ -> Nothing
+ ]
+
+ CastDoubleToWord64Op -> mkPrimOpRule nm 1
+ [ unaryLit $ \_env -> \case
+ LitDouble n -> Just (mkWord64LitWord64 (castDoubleToWord64 (fromRational n)))
+ _ -> Nothing
+ ]
+
+ CastFloatToWord32Op -> mkPrimOpRule nm 1
+ [ unaryLit $ \_env -> \case
+ LitFloat n -> Just (mkWord32LitWord32 (castFloatToWord32 (fromRational n)))
+ _ -> Nothing
+ ]
+
OrdOp -> mkPrimOpRule nm 1 [ liftLit charToIntLit
, semiInversePrimOp ChrOp ]
ChrOp -> mkPrimOpRule nm 1 [ do [Lit lit] <- getArgs
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -1747,6 +1747,10 @@ emitPrimOp cfg primop =
TraceMarkerOp -> alwaysExternal
SetThreadAllocationCounter -> alwaysExternal
KeepAliveOp -> alwaysExternal
+ CastWord32ToFloatOp -> alwaysExternal
+ CastWord64ToDoubleOp -> alwaysExternal
+ CastDoubleToWord64Op -> alwaysExternal
+ CastFloatToWord32Op -> alwaysExternal
where
profile = stgToCmmProfile cfg
=====================================
compiler/GHC/StgToJS/Prim.hs
=====================================
@@ -498,6 +498,8 @@ genPrim prof bound ty op = case op of
DoublePowerOp -> \[r] [x,y] -> pure $ PrimInline $ r |= math_pow [x,y]
DoubleDecode_2IntOp -> \[s,h,l,e] [x] -> pure $ PrimInline $ appT [s,h,l,e] "h$decodeDouble2Int" [x]
DoubleDecode_Int64Op -> \[s1,s2,e] [d] -> pure $ PrimInline $ appT [e,s1,s2] "h$decodeDoubleInt64" [d]
+ CastDoubleToWord64Op -> \[rh,rl] [x] -> pure $ PrimInline $ appT [rh,rl] "h$castDoubleToWord64" [x]
+ CastWord64ToDoubleOp -> \[r] [h,l] -> pure $ PrimInline $ appT [r] "h$castWord64ToDouble" [h,l]
DoubleFMAdd -> unhandledPrimop op
DoubleFMSub -> unhandledPrimop op
@@ -539,6 +541,9 @@ genPrim prof bound ty op = case op of
FloatPowerOp -> \[r] [x,y] -> pure $ PrimInline $ r |= math_fround [math_pow [x,y]]
FloatToDoubleOp -> \[r] [x] -> pure $ PrimInline $ r |= x
FloatDecode_IntOp -> \[s,e] [x] -> pure $ PrimInline $ appT [s,e] "h$decodeFloatInt" [x]
+ CastFloatToWord32Op -> \[r] [x] -> pure $ PrimInline $ appT [r] "h$castFloatToWord32" [x]
+ CastWord32ToFloatOp -> \[r] [x] -> pure $ PrimInline $ appT [r] "h$castWord32ToFloat" [x]
+
FloatFMAdd -> unhandledPrimop op
FloatFMSub -> unhandledPrimop op
=====================================
libraries/ghc-internal/cbits/CastFloatWord.cmm deleted
=====================================
@@ -1,70 +0,0 @@
-#include "Cmm.h"
-#include "MachDeps.h"
-
-#if WORD_SIZE_IN_BITS == 64
-#define DOUBLE_SIZE_WDS 1
-#else
-#define DOUBLE_SIZE_WDS 2
-#endif
-
-stg_word64ToDoublezh(I64 w)
-{
- D_ d;
- P_ ptr;
-
- STK_CHK_GEN_N (DOUBLE_SIZE_WDS);
-
- reserve DOUBLE_SIZE_WDS = ptr {
- I64[ptr] = w;
- d = D_[ptr];
- }
-
- return (d);
-}
-
-stg_doubleToWord64zh(D_ d)
-{
- I64 w;
- P_ ptr;
-
- STK_CHK_GEN_N (DOUBLE_SIZE_WDS);
-
- reserve DOUBLE_SIZE_WDS = ptr {
- D_[ptr] = d;
- w = I64[ptr];
- }
-
- return (w);
-}
-
-stg_word32ToFloatzh(W_ w)
-{
- F_ f;
- P_ ptr;
-
- STK_CHK_GEN_N (1);
-
- reserve 1 = ptr {
- I32[ptr] = %lobits32(w);
- f = F_[ptr];
- }
-
- return (f);
-}
-
-stg_floatToWord32zh(F_ f)
-{
- W_ w;
- P_ ptr;
-
- STK_CHK_GEN_N (1);
-
- reserve 1 = ptr {
- F_[ptr] = f;
- // Fix #16617: use zero-extending (TO_ZXW_) here
- w = TO_ZXW_(I32[ptr]);
- }
-
- return (w);
-}
-
=====================================
libraries/ghc-internal/ghc-internal.cabal
=====================================
@@ -347,7 +347,6 @@ Library
cbits/fs.c
cmm-sources:
- cbits/CastFloatWord.cmm
cbits/StackCloningDecoding.cmm
if arch(javascript)
=====================================
libraries/ghc-internal/src/GHC/Float.hs
=====================================
@@ -1,7 +1,6 @@
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE BangPatterns
, CPP
- , GHCForeignImportPrim
, NoImplicitPrelude
, MagicHash
, UnboxedTuples
@@ -60,6 +59,8 @@ module GHC.Float
, rationalToFloat
, castWord32ToFloat
, castFloatToWord32
+ , castWord32ToFloat#
+ , castFloatToWord32#
, float2Double
-- ** Operations
, floorFloat
@@ -97,6 +98,8 @@ module GHC.Float
, rationalToDouble
, castWord64ToDouble
, castDoubleToWord64
+ , castWord64ToDouble#
+ , castDoubleToWord64#
, double2Float
-- ** Operations
, floorDouble
@@ -1735,6 +1738,25 @@ read it from memory into the destination register and the best way to do that
is using CMM.
-}
+-- Deprecated since GHC 9.10.
+{-# DEPRECATED stgDoubleToWord64 "Use castDoubleToWord64# instead" #-}
+{-# DEPRECATED stgWord64ToDouble "Use castWord64ToDouble# instead" #-}
+{-# DEPRECATED stgFloatToWord32 "Use castFloatToWord32# instead" #-}
+{-# DEPRECATED stgWord32ToFloat "Use castWord32ToFloat# instead" #-}
+
+stgDoubleToWord64 :: Double# -> Word64#
+stgDoubleToWord64 = castDoubleToWord64#
+
+stgWord64ToDouble :: Word64# -> Double#
+stgWord64ToDouble = castWord64ToDouble#
+
+stgFloatToWord32 :: Float# -> Word32#
+stgFloatToWord32 = castFloatToWord32#
+
+stgWord32ToFloat :: Word32# -> Float#
+stgWord32ToFloat = castWord32ToFloat#
+
+
-- | @'castWord32ToFloat' w@ does a bit-for-bit copy from an integral value
-- to a floating-point value.
--
@@ -1742,11 +1764,7 @@ is using CMM.
{-# INLINE castWord32ToFloat #-}
castWord32ToFloat :: Word32 -> Float
-castWord32ToFloat (W32# w#) = F# (stgWord32ToFloat w#)
-
-foreign import prim "stg_word32ToFloatzh"
- stgWord32ToFloat :: Word32# -> Float#
-
+castWord32ToFloat (W32# w#) = F# (castWord32ToFloat# w#)
-- | @'castFloatToWord32' f@ does a bit-for-bit copy from a floating-point value
-- to an integral value.
@@ -1755,12 +1773,7 @@ foreign import prim "stg_word32ToFloatzh"
{-# INLINE castFloatToWord32 #-}
castFloatToWord32 :: Float -> Word32
-castFloatToWord32 (F# f#) = W32# (stgFloatToWord32 f#)
-
-foreign import prim "stg_floatToWord32zh"
- stgFloatToWord32 :: Float# -> Word32#
-
-
+castFloatToWord32 (F# f#) = W32# (castFloatToWord32# f#)
-- | @'castWord64ToDouble' w@ does a bit-for-bit copy from an integral value
-- to a floating-point value.
@@ -1769,25 +1782,16 @@ foreign import prim "stg_floatToWord32zh"
{-# INLINE castWord64ToDouble #-}
castWord64ToDouble :: Word64 -> Double
-castWord64ToDouble (W64# w) = D# (stgWord64ToDouble w)
-
-foreign import prim "stg_word64ToDoublezh"
- stgWord64ToDouble :: Word64# -> Double#
+castWord64ToDouble (W64# w) = D# (castWord64ToDouble# w)
-
--- | @'castFloatToWord64' f@ does a bit-for-bit copy from a floating-point value
+-- | @'castDoubleToWord64' f@ does a bit-for-bit copy from a floating-point value
-- to an integral value.
--
-- @since 4.11.0.0
{-# INLINE castDoubleToWord64 #-}
castDoubleToWord64 :: Double -> Word64
-castDoubleToWord64 (D# d#) = W64# (stgDoubleToWord64 d#)
-
-foreign import prim "stg_doubleToWord64zh"
- stgDoubleToWord64 :: Double# -> Word64#
-
-
+castDoubleToWord64 (D# d#) = W64# (castDoubleToWord64# d#)
-- See Note [Optimising conversions between numeric types]
-- in GHC.Num.Integer
=====================================
rts/PrimOps.cmm
=====================================
@@ -2954,3 +2954,73 @@ INFO_TABLE_RET(stg_keepAlive_frame, RET_SMALL, KEEP_ALIVE_FRAME_FIELDS(W_,P_, in
{
return (ret);
}
+
+
+
+#if WORD_SIZE_IN_BITS == 64
+#define DOUBLE_SIZE_WDS 1
+#else
+#define DOUBLE_SIZE_WDS 2
+#endif
+
+stg_castWord64ToDoublezh(I64 w)
+{
+ D_ d;
+ P_ ptr;
+
+ ASSERT(RESERVED_STACK_WORDS >= DOUBLE_SIZE_WDS);
+
+ reserve DOUBLE_SIZE_WDS = ptr {
+ I64[ptr] = w;
+ d = D_[ptr];
+ }
+
+ return (d);
+}
+
+stg_castDoubleToWord64zh(D_ d)
+{
+ I64 w;
+ P_ ptr;
+
+ ASSERT(RESERVED_STACK_WORDS >= DOUBLE_SIZE_WDS);
+
+ reserve DOUBLE_SIZE_WDS = ptr {
+ D_[ptr] = d;
+ w = I64[ptr];
+ }
+
+ return (w);
+}
+
+stg_castWord32ToFloatzh(W_ w)
+{
+ F_ f;
+ P_ ptr;
+
+ ASSERT(RESERVED_STACK_WORDS >= 1);
+
+ reserve 1 = ptr {
+ I32[ptr] = %lobits32(w);
+ f = F_[ptr];
+ }
+
+ return (f);
+}
+
+stg_castFloatToWord32zh(F_ f)
+{
+ W_ w;
+ P_ ptr;
+
+ ASSERT(RESERVED_STACK_WORDS >= 1);
+
+ reserve 1 = ptr {
+ F_[ptr] = f;
+ // Fix #16617: use zero-extending (TO_ZXW_) here
+ w = TO_ZXW_(I32[ptr]);
+ }
+
+ return (w);
+}
+
=====================================
rts/RtsSymbols.c
=====================================
@@ -953,6 +953,10 @@ extern char **environ;
SymI_HasProto(rtsBadAlignmentBarf) \
SymI_HasProto(rtsOutOfBoundsAccess) \
SymI_HasProto(rtsMemcpyRangeOverlap) \
+ SymI_HasDataProto(stg_castWord64ToDoublezh) \
+ SymI_HasDataProto(stg_castDoubleToWord64zh) \
+ SymI_HasDataProto(stg_castWord32ToFloatzh) \
+ SymI_HasDataProto(stg_castFloatToWord32zh) \
RTS_USER_SIGNALS_SYMBOLS \
RTS_INTCHAR_SYMBOLS
=====================================
rts/include/stg/MiscClosures.h
=====================================
@@ -590,6 +590,11 @@ RTS_FUN_DECL(stg_traceMarkerzh);
RTS_FUN_DECL(stg_getThreadAllocationCounterzh);
RTS_FUN_DECL(stg_setThreadAllocationCounterzh);
+RTS_FUN_DECL(stg_castWord64ToDoublezh);
+RTS_FUN_DECL(stg_castDoubleToWord64zh);
+RTS_FUN_DECL(stg_castWord32ToFloatzh);
+RTS_FUN_DECL(stg_castFloatToWord32zh);
+
/* Other misc stuff */
// See wiki:commentary/compiler/backends/ppr-c#prototypes
=====================================
rts/js/arith.js
=====================================
@@ -621,23 +621,23 @@ function h$__word_encodeFloat(j,e) {
return Math.fround((j>>>0) * (2 ** (e|0)));
}
-function h$stg_word32ToFloatzh(v) {
+function h$castWord32ToFloat(v) {
h$convertWord[0] = v;
return h$convertFloat[0];
}
-function h$stg_floatToWord32zh(v) {
+function h$castFloatToWord32(v) {
h$convertFloat[0] = v;
return h$convertWord[0];
}
-function h$stg_word64ToDoublezh(h,l) {
+function h$castWord64ToDouble(h,l) {
h$convertWord[0] = l;
h$convertWord[1] = h;
return h$convertDouble[0];
}
-function h$stg_doubleToWord64zh(v) {
+function h$castDoubleToWord64(v) {
h$convertDouble[0] = v;
var l = h$convertWord[0];
var h = h$convertWord[1];
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -3547,6 +3547,10 @@ module GHC.Base where
casIntArray# :: forall d. MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> (# State# d, Int# #)
casMutVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). MutVar# d a -> a -> a -> State# d -> (# State# d, Int#, a #)
casSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> Int# -> a -> a -> State# d -> (# State# d, Int#, a #)
+ castDoubleToWord64# :: Double# -> Word64#
+ castFloatToWord32# :: Float# -> Word32#
+ castWord32ToFloat# :: Word32# -> Float#
+ castWord64ToDouble# :: Word64# -> Double#
catch# :: forall {q :: RuntimeRep} {k :: Levity} (a :: TYPE q) (b :: TYPE (BoxedRep k)). (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchRetry# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)). (State# RealWorld -> (# State# RealWorld, a #)) -> (State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchSTM# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) b. (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
@@ -5695,6 +5699,10 @@ module GHC.Exts where
casIntArray# :: forall d. MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> (# State# d, Int# #)
casMutVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). MutVar# d a -> a -> a -> State# d -> (# State# d, Int#, a #)
casSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> Int# -> a -> a -> State# d -> (# State# d, Int#, a #)
+ castDoubleToWord64# :: Double# -> Word64#
+ castFloatToWord32# :: Float# -> Word32#
+ castWord32ToFloat# :: Word32# -> Float#
+ castWord64ToDouble# :: Word64# -> Double#
catch# :: forall {q :: RuntimeRep} {k :: Levity} (a :: TYPE q) (b :: TYPE (BoxedRep k)). (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchRetry# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)). (State# RealWorld -> (# State# RealWorld, a #)) -> (State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchSTM# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) b. (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
@@ -7110,9 +7118,13 @@ module GHC.Float where
atanhDouble :: Double -> Double
atanhFloat :: Float -> Float
castDoubleToWord64 :: Double -> GHC.Word.Word64
+ castDoubleToWord64# :: Double# -> GHC.Prim.Word64#
castFloatToWord32 :: Float -> GHC.Word.Word32
+ castFloatToWord32# :: Float# -> GHC.Prim.Word32#
castWord32ToFloat :: GHC.Word.Word32 -> Float
+ castWord32ToFloat# :: GHC.Prim.Word32# -> Float#
castWord64ToDouble :: GHC.Word.Word64 -> Double
+ castWord64ToDouble# :: GHC.Prim.Word64# -> Double#
ceilingDouble :: forall b. GHC.Real.Integral b => Double -> b
ceilingFloat :: forall b. GHC.Real.Integral b => Float -> b
clamp :: GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -3547,6 +3547,10 @@ module GHC.Base where
casIntArray# :: forall d. MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> (# State# d, Int# #)
casMutVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). MutVar# d a -> a -> a -> State# d -> (# State# d, Int#, a #)
casSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> Int# -> a -> a -> State# d -> (# State# d, Int#, a #)
+ castDoubleToWord64# :: Double# -> Word64#
+ castFloatToWord32# :: Float# -> Word32#
+ castWord32ToFloat# :: Word32# -> Float#
+ castWord64ToDouble# :: Word64# -> Double#
catch# :: forall {q :: RuntimeRep} {k :: Levity} (a :: TYPE q) (b :: TYPE (BoxedRep k)). (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchRetry# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)). (State# RealWorld -> (# State# RealWorld, a #)) -> (State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchSTM# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) b. (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
@@ -5664,6 +5668,10 @@ module GHC.Exts where
casIntArray# :: forall d. MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> (# State# d, Int# #)
casMutVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). MutVar# d a -> a -> a -> State# d -> (# State# d, Int#, a #)
casSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> Int# -> a -> a -> State# d -> (# State# d, Int#, a #)
+ castDoubleToWord64# :: Double# -> Word64#
+ castFloatToWord32# :: Float# -> Word32#
+ castWord32ToFloat# :: Word32# -> Float#
+ castWord64ToDouble# :: Word64# -> Double#
catch# :: forall {q :: RuntimeRep} {k :: Levity} (a :: TYPE q) (b :: TYPE (BoxedRep k)). (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchRetry# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)). (State# RealWorld -> (# State# RealWorld, a #)) -> (State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchSTM# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) b. (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
@@ -7079,9 +7087,13 @@ module GHC.Float where
atanhDouble :: Double -> Double
atanhFloat :: Float -> Float
castDoubleToWord64 :: Double -> GHC.Word.Word64
+ castDoubleToWord64# :: Double# -> GHC.Prim.Word64#
castFloatToWord32 :: Float -> GHC.Word.Word32
+ castFloatToWord32# :: Float# -> GHC.Prim.Word32#
castWord32ToFloat :: GHC.Word.Word32 -> Float
+ castWord32ToFloat# :: GHC.Prim.Word32# -> Float#
castWord64ToDouble :: GHC.Word.Word64 -> Double
+ castWord64ToDouble# :: GHC.Prim.Word64# -> Double#
ceilingDouble :: forall b. GHC.Real.Integral b => Double -> b
ceilingFloat :: forall b. GHC.Real.Integral b => Float -> b
clamp :: GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -3550,6 +3550,10 @@ module GHC.Base where
casIntArray# :: forall d. MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> (# State# d, Int# #)
casMutVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). MutVar# d a -> a -> a -> State# d -> (# State# d, Int#, a #)
casSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> Int# -> a -> a -> State# d -> (# State# d, Int#, a #)
+ castDoubleToWord64# :: Double# -> Word64#
+ castFloatToWord32# :: Float# -> Word32#
+ castWord32ToFloat# :: Word32# -> Float#
+ castWord64ToDouble# :: Word64# -> Double#
catch# :: forall {q :: RuntimeRep} {k :: Levity} (a :: TYPE q) (b :: TYPE (BoxedRep k)). (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchRetry# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)). (State# RealWorld -> (# State# RealWorld, a #)) -> (State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchSTM# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) b. (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
@@ -5844,6 +5848,10 @@ module GHC.Exts where
casIntArray# :: forall d. MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> (# State# d, Int# #)
casMutVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). MutVar# d a -> a -> a -> State# d -> (# State# d, Int#, a #)
casSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> Int# -> a -> a -> State# d -> (# State# d, Int#, a #)
+ castDoubleToWord64# :: Double# -> Word64#
+ castFloatToWord32# :: Float# -> Word32#
+ castWord32ToFloat# :: Word32# -> Float#
+ castWord64ToDouble# :: Word64# -> Double#
catch# :: forall {q :: RuntimeRep} {k :: Levity} (a :: TYPE q) (b :: TYPE (BoxedRep k)). (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchRetry# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)). (State# RealWorld -> (# State# RealWorld, a #)) -> (State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchSTM# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) b. (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
@@ -7259,9 +7267,13 @@ module GHC.Float where
atanhDouble :: Double -> Double
atanhFloat :: Float -> Float
castDoubleToWord64 :: Double -> GHC.Word.Word64
+ castDoubleToWord64# :: Double# -> GHC.Prim.Word64#
castFloatToWord32 :: Float -> GHC.Word.Word32
+ castFloatToWord32# :: Float# -> GHC.Prim.Word32#
castWord32ToFloat :: GHC.Word.Word32 -> Float
+ castWord32ToFloat# :: GHC.Prim.Word32# -> Float#
castWord64ToDouble :: GHC.Word.Word64 -> Double
+ castWord64ToDouble# :: GHC.Prim.Word64# -> Double#
ceilingDouble :: forall b. GHC.Real.Integral b => Double -> b
ceilingFloat :: forall b. GHC.Real.Integral b => Float -> b
clamp :: GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -3547,6 +3547,10 @@ module GHC.Base where
casIntArray# :: forall d. MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> (# State# d, Int# #)
casMutVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). MutVar# d a -> a -> a -> State# d -> (# State# d, Int#, a #)
casSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> Int# -> a -> a -> State# d -> (# State# d, Int#, a #)
+ castDoubleToWord64# :: Double# -> Word64#
+ castFloatToWord32# :: Float# -> Word32#
+ castWord32ToFloat# :: Word32# -> Float#
+ castWord64ToDouble# :: Word64# -> Double#
catch# :: forall {q :: RuntimeRep} {k :: Levity} (a :: TYPE q) (b :: TYPE (BoxedRep k)). (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchRetry# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)). (State# RealWorld -> (# State# RealWorld, a #)) -> (State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchSTM# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) b. (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
@@ -5695,6 +5699,10 @@ module GHC.Exts where
casIntArray# :: forall d. MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> (# State# d, Int# #)
casMutVar# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). MutVar# d a -> a -> a -> State# d -> (# State# d, Int#, a #)
casSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> Int# -> a -> a -> State# d -> (# State# d, Int#, a #)
+ castDoubleToWord64# :: Double# -> Word64#
+ castFloatToWord32# :: Float# -> Word32#
+ castWord32ToFloat# :: Word32# -> Float#
+ castWord64ToDouble# :: Word64# -> Double#
catch# :: forall {q :: RuntimeRep} {k :: Levity} (a :: TYPE q) (b :: TYPE (BoxedRep k)). (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchRetry# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)). (State# RealWorld -> (# State# RealWorld, a #)) -> (State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
catchSTM# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) b. (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #)
@@ -7110,9 +7118,13 @@ module GHC.Float where
atanhDouble :: Double -> Double
atanhFloat :: Float -> Float
castDoubleToWord64 :: Double -> GHC.Word.Word64
+ castDoubleToWord64# :: Double# -> GHC.Prim.Word64#
castFloatToWord32 :: Float -> GHC.Word.Word32
+ castFloatToWord32# :: Float# -> GHC.Prim.Word32#
castWord32ToFloat :: GHC.Word.Word32 -> Float
+ castWord32ToFloat# :: GHC.Prim.Word32# -> Float#
castWord64ToDouble :: GHC.Word.Word64 -> Double
+ castWord64ToDouble# :: GHC.Prim.Word64# -> Double#
ceilingDouble :: forall b. GHC.Real.Integral b => Double -> b
ceilingFloat :: forall b. GHC.Real.Integral b => Float -> b
clamp :: GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int
=====================================
testsuite/tests/numeric/should_compile/T24331.hs
=====================================
@@ -0,0 +1,16 @@
+module T24331 where
+
+import GHC.Float
+import GHC.Word
+
+a :: Word64
+a = castDoubleToWord64 1.0
+
+b :: Word32
+b = castFloatToWord32 2.0
+
+c :: Double
+c = castWord64ToDouble 4621819117588971520
+
+d :: Float
+d = castWord32ToFloat 1084227584
=====================================
testsuite/tests/numeric/should_compile/T24331.stderr
=====================================
@@ -0,0 +1,15 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+ = {terms: 12, types: 4, coercions: 0, joins: 0/0}
+
+a = W64# 4607182418800017408#Word64
+
+b = W32# 1073741824#Word32
+
+c = D# 10.0##
+
+d = F# 5.0#
+
+
+
=====================================
testsuite/tests/numeric/should_compile/all.T
=====================================
@@ -21,3 +21,4 @@ test('T19641', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-b
test('T15547', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques'])
test('T23019', normal, compile, ['-O'])
test('T23907', [ when(wordsize(32), expect_broken(23908))], compile, ['-ddump-simpl -O2 -dsuppress-all -dno-typeable-binds -dsuppress-uniques'])
+test('T24331', normal, compile, ['-O -ddump-simpl -dsuppress-all -dsuppress-uniques -dno-typeable-binds'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/902ebcc2b95707319d37a19d6b23c342cc14b162...401dfe7bbaad4a35f0cc72a078dfcedc7ab9af67
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/902ebcc2b95707319d37a19d6b23c342cc14b162...401dfe7bbaad4a35f0cc72a078dfcedc7ab9af67
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240217/f2db4d0e/attachment-0001.html>
More information about the ghc-commits
mailing list