Add constant folding rule (#16402)

    narrowN (x .&. m)
    m .&. (2^N-1) = 2^N-1
    ==> narrowN x

e.g.  narrow16 (x .&. 0x12FFFF) ==> narrow16 x

3 files changed, 56 insertions, 0 deletions

diff --git a/testsuite/tests/numeric/should_compile/T16402.hs b/testsuite/tests/numeric/should_compile/T16402.hs
new file mode 100644
index 0000000000..c85fe0037b
--- /dev/null
+++ b/testsuite/tests/numeric/should_compile/T16402.hs
@@ -0,0 +1,19 @@
+{-# OPTIONS_GHC -ddump-simpl -dhex-word-literals -dsuppress-all -dsuppress-uniques -O2 #-}
+{-# LANGUAGE TypeApplications #-}
+module T16402 where
+
+import Data.Word
+import Data.Int
+import Data.Bits
+
+smallWord_foo :: Word64 -> Word64
+smallWord_foo x = fromIntegral @Word16 $ fromIntegral (x .&. 0xFFFF)
+
+smallWord_bar :: Word64 -> Word64
+smallWord_bar x = fromIntegral (fromIntegral x :: Word16)
+
+smallInt_foo :: Int64 -> Int64
+smallInt_foo x = fromIntegral @Int16 $ fromIntegral (x .&. 0x12FFFF)
+
+smallInt_bar :: Int64 -> Int64
+smallInt_bar x = fromIntegral (fromIntegral x :: Int16)
diff --git a/testsuite/tests/numeric/should_compile/T16402.stderr b/testsuite/tests/numeric/should_compile/T16402.stderr
new file mode 100644
index 0000000000..75db843376
--- /dev/null
+++ b/testsuite/tests/numeric/should_compile/T16402.stderr
@@ -0,0 +1,36 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 34, types: 19, coercions: 0, joins: 0/0}
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$trModule3 = TrNameS $trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$trModule2 = "T16402"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$trModule1 = TrNameS $trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$trModule = Module $trModule3 $trModule1
+
+-- RHS size: {terms: 7, types: 3, coercions: 0, joins: 0/0}
+smallWord_bar
+  = \ x -> case x of { W64# x# -> W64# (narrow16Word# x#) }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+smallWord_foo = smallWord_bar
+
+-- RHS size: {terms: 7, types: 3, coercions: 0, joins: 0/0}
+smallInt_bar
+  = \ x -> case x of { I64# x# -> I64# (narrow16Int# x#) }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+smallInt_foo = smallInt_bar
+
+
+
diff --git a/testsuite/tests/numeric/should_compile/all.T b/testsuite/tests/numeric/should_compile/all.T
index 625951f4d6..a7dc06cf44 100644
--- a/testsuite/tests/numeric/should_compile/all.T
+++ b/testsuite/tests/numeric/should_compile/all.T
@@ -9,3 +9,4 @@ test('T7881', normal, compile, [''])
 # desugaring, so we don't get the warning we expect.
 test('T8542', omit_ways(['hpc']), compile, [''])
 test('T10929', normal, compile, [''])
+test('T16402', [ grep_errmsg(r'and') ], compile, [''])