diff options
| -rw-r--r-- | compiler/GHC/Core/Opt/ConstantFold.hs | 45 | ||||
| -rw-r--r-- | testsuite/tests/numeric/should_compile/T20376.hs | 39 | ||||
| -rw-r--r-- | testsuite/tests/numeric/should_compile/T20376.stderr | 57 | ||||
| -rw-r--r-- | testsuite/tests/numeric/should_compile/all.T | 1 |
4 files changed, 142 insertions, 0 deletions
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs index 3d5fd4ed0f..083150ba81 100644 --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/compiler/GHC/Core/Opt/ConstantFold.hs @@ -491,6 +491,33 @@ primOpRules nm = \case WordSllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord (const shiftL) ] WordSrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord shiftRightLogicalNative ] + PopCnt8Op -> mkPrimOpRule nm 1 [ pop_count @Word8 ] + PopCnt16Op -> mkPrimOpRule nm 1 [ pop_count @Word16 ] + PopCnt32Op -> mkPrimOpRule nm 1 [ pop_count @Word32 ] + PopCnt64Op -> mkPrimOpRule nm 1 [ pop_count @Word64 ] + PopCntOp -> mkPrimOpRule nm 1 [ getWordSize >>= \case + PW4 -> pop_count @Word32 + PW8 -> pop_count @Word64 + ] + + Ctz8Op -> mkPrimOpRule nm 1 [ ctz @Word8 ] + Ctz16Op -> mkPrimOpRule nm 1 [ ctz @Word16 ] + Ctz32Op -> mkPrimOpRule nm 1 [ ctz @Word32 ] + Ctz64Op -> mkPrimOpRule nm 1 [ ctz @Word64 ] + CtzOp -> mkPrimOpRule nm 1 [ getWordSize >>= \case + PW4 -> ctz @Word32 + PW8 -> ctz @Word64 + ] + + Clz8Op -> mkPrimOpRule nm 1 [ clz @Word8 ] + Clz16Op -> mkPrimOpRule nm 1 [ clz @Word16 ] + Clz32Op -> mkPrimOpRule nm 1 [ clz @Word32 ] + Clz64Op -> mkPrimOpRule nm 1 [ clz @Word64 ] + ClzOp -> mkPrimOpRule nm 1 [ getWordSize >>= \case + PW4 -> clz @Word32 + PW8 -> clz @Word64 + ] + -- coercions Int8ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ] @@ -1422,6 +1449,9 @@ instance MonadPlus RuleM getPlatform :: RuleM Platform getPlatform = roPlatform <$> getRuleOpts +getWordSize :: RuleM PlatformWordSize +getWordSize = platformWordSize <$> getPlatform + getRuleOpts :: RuleM RuleOpts getRuleOpts = RuleM $ \rule_opts _ _ _ -> Just rule_opts @@ -1614,6 +1644,21 @@ nonZeroLit n = getLiteral n >>= guard . not . isZeroLit oneLit :: Int -> RuleM () oneLit n = getLiteral n >>= guard . isOneLit +lift_bits_op :: forall a. (Num a, FiniteBits a) => (a -> Integer) -> RuleM CoreExpr +lift_bits_op op = do + platform <- getPlatform + [Lit (LitNumber _ l)] <- getArgs + pure $ mkWordLit platform $ op (fromInteger l :: a) + +pop_count :: forall a. (Num a, FiniteBits a) => RuleM CoreExpr +pop_count = lift_bits_op @a (fromIntegral . popCount) + +ctz :: forall a. (Num a, FiniteBits a) => RuleM CoreExpr +ctz = lift_bits_op @a (fromIntegral . countTrailingZeros) + +clz :: forall a. (Num a, FiniteBits a) => RuleM CoreExpr +clz = lift_bits_op @a (fromIntegral . countLeadingZeros) + -- When excess precision is not requested, cut down the precision of the -- Rational value to that of Float/Double. We confuse host architecture -- and target architecture here, but it's convenient (and wrong :-). diff --git a/testsuite/tests/numeric/should_compile/T20376.hs b/testsuite/tests/numeric/should_compile/T20376.hs new file mode 100644 index 0000000000..5290503708 --- /dev/null +++ b/testsuite/tests/numeric/should_compile/T20376.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module T20376 where + +import GHC.Exts +import GHC.Word +import Data.Bits + +foo0 (# #) = popCnt# 123456789## +foo1 (# #) = popCnt8# 89## +foo2 (# #) = popCnt16# 56789## +foo3 (# #) = popCnt32# 123456789## + +foo0' = popCount (123456789 :: Word) +foo1' = popCount ( 89 :: Word8) +foo2' = popCount ( 56789 :: Word16) +foo3' = popCount (123456789 :: Word32) +foo4' = popCount (123456789123456789 :: Word64) + +ctz0 (# #) = ctz# 0xC0000000## +ctz1 (# #) = ctz8# 0xC0## +ctz2 (# #) = ctz16# 0xC000## +ctz3 (# #) = ctz32# 0xC0000000## + +ctz0' = countTrailingZeros (0xC0000000 :: Word) +ctz1' = countTrailingZeros ( 0xC0 :: Word8) +ctz2' = countTrailingZeros ( 0xC000 :: Word16) +ctz3' = countTrailingZeros (0xC0000000 :: Word32) +ctz4' = countTrailingZeros (0xC000000000000000 :: Word64) + +clz1 (# #) = clz8# 0x04## +clz2 (# #) = clz16# 0x0004## +clz3 (# #) = clz32# 0x00000004## + +clz1' = countLeadingZeros ( 0x04 :: Word8) +clz2' = countLeadingZeros ( 0x0004 :: Word16) +clz3' = countLeadingZeros (0x00000004 :: Word32) +clz4' = countLeadingZeros (0x0000000000000004 :: Word64) diff --git a/testsuite/tests/numeric/should_compile/T20376.stderr b/testsuite/tests/numeric/should_compile/T20376.stderr new file mode 100644 index 0000000000..0bcf76151d --- /dev/null +++ b/testsuite/tests/numeric/should_compile/T20376.stderr @@ -0,0 +1,57 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 71, types: 45, coercions: 0, joins: 0/0} + +foo0 = \ _ -> 16## + +foo1 = \ _ -> 4## + +foo2 = \ _ -> 11## + +foo3 = foo0 + +foo0' = I# 16# + +foo1' = I# 4# + +foo2' = I# 11# + +foo3' = foo0' + +foo4' = I# 31# + +ctz0 = \ _ -> 30## + +ctz1 = \ _ -> 6## + +ctz2 = \ _ -> 14## + +ctz3 = ctz0 + +ctz0' = I# 30# + +ctz1' = I# 6# + +ctz2' = I# 14# + +ctz3' = ctz0' + +ctz4' = I# 62# + +clz1 = \ _ -> 5## + +clz2 = \ _ -> 13## + +clz3 = \ _ -> 29## + +clz1' = I# 5# + +clz2' = I# 13# + +clz3' = I# 29# + +clz4' = I# 61# + + + diff --git a/testsuite/tests/numeric/should_compile/all.T b/testsuite/tests/numeric/should_compile/all.T index c95296fcde..5a0f9efae3 100644 --- a/testsuite/tests/numeric/should_compile/all.T +++ b/testsuite/tests/numeric/should_compile/all.T @@ -12,3 +12,4 @@ test('T16402', [ grep_errmsg(r'and'), when(wordsize(32), expect_broken(19024)) ] test('T19892', normal, compile, ['-O -ddump-rule-firings']) test('T20062', [ grep_errmsg(r'integer') ], compile, ['-ddump-simpl -O -dsuppress-all']) test('T20245', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds']) +test('T20376', normal, compile, ['-ddump-simpl -O -dsuppress-all -dsuppress-uniques -dno-typeable-binds']) |