diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-05-17 12:29:35 +0100 |
|---|---|---|
| committer | Matthew Pickering <matthewtpickering@gmail.com> | 2021-05-17 12:30:38 +0100 |
| commit | c7b5ba5474069bea4609878d6d6c99de61261e2d (patch) | |
| tree | ebdaa2b868d636d4c8f99a88349c45c399fa91b5 | |
| parent | fc9546caf3e16db070bfc7bb5523c38595233e26 (diff) | |
| download | haskell-wip/t19851.tar.gz | |
constant folding: Make shiftRule for Word8/16/32# types return correct typewip/t19851
Fixes #19851
| -rw-r--r-- | compiler/GHC/Core/Opt/ConstantFold.hs | 12 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_compile/T19851.hs | 11 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_compile/all.T | 1 |
3 files changed, 18 insertions, 6 deletions
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs index 6bd7f41d3b..63175e1b99 100644 --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/compiler/GHC/Core/Opt/ConstantFold.hs @@ -163,8 +163,8 @@ primOpRules nm = \case , equalArgs $> Lit zeroW8 ] Word8NotOp -> mkPrimOpRule nm 1 [ unaryLit complementOp , semiInversePrimOp Word8NotOp ] - Word8SllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord (const shiftL) ] - Word8SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord $ const $ shiftRightLogical @Word8 ] + Word8SllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord8 (const shiftL) ] + Word8SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord8 $ const $ shiftRightLogical @Word8 ] -- Int16 operations @@ -230,8 +230,8 @@ primOpRules nm = \case , equalArgs $> Lit zeroW16 ] Word16NotOp -> mkPrimOpRule nm 1 [ unaryLit complementOp , semiInversePrimOp Word16NotOp ] - Word16SllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord (const shiftL) ] - Word16SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord $ const $ shiftRightLogical @Word16 ] + Word16SllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord16 (const shiftL) ] + Word16SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord16 $ const $ shiftRightLogical @Word16 ] -- Int32 operations @@ -297,8 +297,8 @@ primOpRules nm = \case , equalArgs $> Lit zeroW32 ] Word32NotOp -> mkPrimOpRule nm 1 [ unaryLit complementOp , semiInversePrimOp Word32NotOp ] - Word32SllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord (const shiftL) ] - Word32SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord $ const $ shiftRightLogical @Word32 ] + Word32SllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord32 (const shiftL) ] + Word32SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord32 $ const $ shiftRightLogical @Word32 ] -- Int operations diff --git a/testsuite/tests/primops/should_compile/T19851.hs b/testsuite/tests/primops/should_compile/T19851.hs new file mode 100644 index 0000000000..a3a5dd78fc --- /dev/null +++ b/testsuite/tests/primops/should_compile/T19851.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE MagicHash #-} +module T19851 where + +import GHC.Prim +import GHC.Word + + +w8 = W8# (uncheckedShiftLWord8# (wordToWord8# 100##) (-4#)) +w16 = W16# (uncheckedShiftLWord16# (wordToWord16# 100##) (-4#)) +w32 = W32# (uncheckedShiftLWord32# (wordToWord32# 100##) (-4#)) + diff --git a/testsuite/tests/primops/should_compile/all.T b/testsuite/tests/primops/should_compile/all.T index aa7339c445..412b64151b 100644 --- a/testsuite/tests/primops/should_compile/all.T +++ b/testsuite/tests/primops/should_compile/all.T @@ -1,2 +1,3 @@ test('T6135_should_compile', normal, compile, ['']) test('T16293a', normal, compile, ['']) +test('T19851', normal, compile, ['-O']) |