diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2021-11-04 09:37:33 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-11-06 07:53:42 -0400 |
| commit | 4c86df25d360d4001a4a61415bbd86d4fc76d18c (patch) | |
| tree | 748c1523db13cf6fc9d2ea27730f104d925988bf | |
| parent | e279ea6479279b0899d1d2cd683ceb70bb4a77f3 (diff) | |
| download | haskell-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.hs | 16 | ||||
| -rw-r--r-- | compiler/GHC/Types/Literal.hs | 17 |
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) |