summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2021-11-04 09:37:33 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-11-06 07:53:42 -0400
commit4c86df25d360d4001a4a61415bbd86d4fc76d18c (patch)
tree748c1523db13cf6fc9d2ea27730f104d925988bf
parente279ea6479279b0899d1d2cd683ceb70bb4a77f3 (diff)
downloadhaskell-4c86df25d360d4001a4a61415bbd86d4fc76d18c.tar.gz
Fix Int64ToInt/Word64ToWord rules on 32-bit architectures
When the input literal was larger than 32-bit it would crash in a compiler with assertion enabled because it was creating an out-of-bound word-sized literal (32-bit).
-rw-r--r--compiler/GHC/Core/Opt/ConstantFold.hs16
-rw-r--r--compiler/GHC/Types/Literal.hs17
2 files changed, 17 insertions, 16 deletions
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index 0d2db119a8..b9b436ffe5 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -559,10 +559,10 @@ primOpRules nm = \case
-- coercions
- Int8ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ]
- Int16ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ]
- Int32ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ]
- Int64ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ]
+ Int8ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToIntLit ]
+ Int16ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToIntLit ]
+ Int32ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToIntLit ]
+ Int64ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToIntLit ]
IntToInt8Op -> mkPrimOpRule nm 1 [ liftLit narrowInt8Lit
, narrowSubsumesAnd IntAndOp IntToInt8Op 8 ]
IntToInt16Op -> mkPrimOpRule nm 1 [ liftLit narrowInt16Lit
@@ -571,16 +571,16 @@ primOpRules nm = \case
, narrowSubsumesAnd IntAndOp IntToInt32Op 32 ]
IntToInt64Op -> mkPrimOpRule nm 1 [ liftLit narrowInt64Lit ]
- Word8ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit
+ Word8ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToWordLit
, extendNarrowPassthrough WordToWord8Op 0xFF
]
- Word16ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit
+ Word16ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToWordLit
, extendNarrowPassthrough WordToWord16Op 0xFFFF
]
- Word32ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit
+ Word32ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToWordLit
, extendNarrowPassthrough WordToWord32Op 0xFFFFFFFF
]
- Word64ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit ]
+ Word64ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToWordLit ]
WordToWord8Op -> mkPrimOpRule nm 1 [ liftLit narrowWord8Lit
, narrowSubsumesAnd WordAndOp WordToWord8Op 8 ]
diff --git a/compiler/GHC/Types/Literal.hs b/compiler/GHC/Types/Literal.hs
index 7572b5a660..6240e3347a 100644
--- a/compiler/GHC/Types/Literal.hs
+++ b/compiler/GHC/Types/Literal.hs
@@ -58,7 +58,7 @@ module GHC.Types.Literal
-- ** Coercions
, narrowInt8Lit, narrowInt16Lit, narrowInt32Lit, narrowInt64Lit
, narrowWord8Lit, narrowWord16Lit, narrowWord32Lit, narrowWord64Lit
- , extendIntLit, extendWordLit
+ , convertToIntLit, convertToWordLit
, charToIntLit, intToCharLit
, floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit
, nullAddrLit, floatToDoubleLit, doubleToFloatLit
@@ -696,13 +696,14 @@ narrowWord16Lit = narrowLit' @Word16 LitNumWord16
narrowWord32Lit = narrowLit' @Word32 LitNumWord32
narrowWord64Lit = narrowLit' @Word64 LitNumWord64
--- | Extend a fixed-width literal (e.g. 'Int16#') to a word-sized literal (e.g.
--- 'Int#').
-extendWordLit, extendIntLit :: Platform -> Literal -> Literal
-extendWordLit platform (LitNumber _nt i) = mkLitWord platform i
-extendWordLit _platform l = pprPanic "extendWordLit" (ppr l)
-extendIntLit platform (LitNumber _nt i) = mkLitInt platform i
-extendIntLit _platform l = pprPanic "extendIntLit" (ppr l)
+-- | Extend or narrow a fixed-width literal (e.g. 'Int16#') to a target
+-- word-sized literal ('Int#' or 'Word#'). Narrowing can only happen on 32-bit
+-- architectures when we convert a 64-bit literal into a 32-bit one.
+convertToWordLit, convertToIntLit :: Platform -> Literal -> Literal
+convertToWordLit platform (LitNumber _nt i) = mkLitWordWrap platform i
+convertToWordLit _platform l = pprPanic "convertToWordLit" (ppr l)
+convertToIntLit platform (LitNumber _nt i) = mkLitIntWrap platform i
+convertToIntLit _platform l = pprPanic "convertToIntLit" (ppr l)
charToIntLit (LitChar c) = mkLitIntUnchecked (toInteger (ord c))
charToIntLit l = pprPanic "charToIntLit" (ppr l)