Fix #20203 improve constant fold for `and`/`or`

This patch follows the rules specified in note [Constant folding through
nested expressions]. Modifications are summarized below.

- Added andFoldingRules, orFoldingRules to primOpRules under those
xxxxAndOp, xxxxOrOp

- Refactored some helper functions

- Modify data NumOps to include two fields: numAnd and numOr

Resolves: #20203
See also: #19204

4 files changed, 356 insertions, 0 deletions

diff --git a/testsuite/tests/simplCore/should_run/T20203.hs b/testsuite/tests/simplCore/should_run/T20203.hs
new file mode 100644
index 0000000000..ddfb06eb13
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T20203.hs
@@ -0,0 +1,64 @@
+module T20203 where
+
+import Data.Bits
+import Data.Int
+
+bitAndInt :: Int -> Int
+bitAndInt x = (x .&. 0xFA) .&. 0xAF
+
+bitOrInt :: Int -> Int
+bitOrInt x = (x .|. 0xFA) .|. 0xAF
+
+bitAndInt8 :: Int8 -> Int8
+bitAndInt8 x = (x .&. 0x1) .&. 0x10
+
+bitOrInt8 :: Int8 -> Int8
+bitOrInt8 x = (x .|. 0x1) .|. 0x10
+
+bitAndInt16 :: Int16 -> Int16
+bitAndInt16 x = (x .&. 0xFA) .&. 0xAF
+
+bitOrInt16 :: Int16 -> Int16
+bitOrInt16 x = (x .|. 0xFA) .|. 0xAF
+
+bitAndInt32 :: Int32 -> Int32
+bitAndInt32 x = (x .&. 0xFA) .&. 0xAF
+
+bitOrInt32 :: Int32 -> Int32
+bitOrInt32 x = (x .|. 0xFA) .|. 0xAF
+
+bitAndInt64 :: Int64 -> Int64
+bitAndInt64 x = (x .&. 0xFA) .&. 0xAF
+
+bitOrInt64 :: Int64 -> Int64
+bitOrInt64 x = (x .|. 0xFA) .|. 0xAF
+
+bitAndTwoVarInt :: Int -> Int -> Int
+bitAndTwoVarInt x y = (x .&. 0xFA) .&. (y .&. 0xAF)
+
+bitOrTwoVarInt :: Int -> Int -> Int
+bitOrTwoVarInt x y = (x .|. 0xFA) .|. (y .|. 0xAF)
+
+bitAndTwoVarInt8 :: Int8 -> Int8 -> Int8
+bitAndTwoVarInt8 x y = (x .&. 0x1) .&. (y .&. 0x10)
+
+bitOrTwoVarInt8 :: Int8 -> Int8 -> Int8
+bitOrTwoVarInt8 x y = (x .|. 0x1) .|. (y .|. 0x10)
+
+bitAndTwoVarInt16 :: Int16 -> Int16 -> Int16
+bitAndTwoVarInt16 x y = (x .&. 0xFA) .&. (y .&. 0xAF)
+
+bitOrTwoVarInt16 :: Int16 -> Int16 -> Int16
+bitOrTwoVarInt16 x y = (x .|. 0xFA) .|. (y .|. 0xAF)
+
+bitAndTwoVarInt32 :: Int32 -> Int32 -> Int32
+bitAndTwoVarInt32 x y = (x .&. 0xFA) .&. (y .&. 0xAF)
+
+bitOrTwoVarInt32 :: Int32 -> Int32 -> Int32
+bitOrTwoVarInt32 x y = (x .|. 0xFA) .|. (y .|. 0xAF)
+
+bitAndTwoVarInt64 :: Int64 -> Int64 -> Int64
+bitAndTwoVarInt64 x y = (x .&. 0xFA) .&. (y .&. 0xAF)
+
+bitOrTwoVarInt64 :: Int64 -> Int64 -> Int64
+bitOrTwoVarInt64 x y = (x .|. 0xFA) .|. (y .|. 0xAF)
diff --git a/testsuite/tests/simplCore/should_run/T20203.stderr-ws-32 b/testsuite/tests/simplCore/should_run/T20203.stderr-ws-32
new file mode 100644
index 0000000000..2d904fc5a4
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T20203.stderr-ws-32
@@ -0,0 +1,153 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 290, types: 141, coercions: 0, joins: 0/0}
+
+bitOrTwoVarInt
+  = \ x y ->
+      case x of { I# x# ->
+      case y of { I# x#1 -> I# (orI# 255# (orI# x# x#1)) }
+      }
+
+bitAndTwoVarInt
+  = \ x y ->
+      case x of { I# x# ->
+      case y of { I# x#1 -> I# (andI# 170# (andI# x# x#1)) }
+      }
+
+bitOrInt = \ x -> case x of { I# x# -> I# (orI# 255# x#) }
+
+bitAndInt = \ x -> case x of { I# x# -> I# (andI# 170# x#) }
+
+bitOrTwoVarInt8
+  = \ x y ->
+      case x of { I8# x# ->
+      case y of { I8# x#1 ->
+      I8#
+        (word8ToInt8#
+           (orWord8# 17##8 (orWord8# (int8ToWord8# x#) (int8ToWord8# x#1))))
+      }
+      }
+
+bitAndInt1 = I8# 0#8
+
+bitAndTwoVarInt8
+  = \ x y ->
+      case x of { I8# x# -> case y of { I8# x#1 -> bitAndInt1 } }
+
+bitOrInt8
+  = \ x ->
+      case x of { I8# x# ->
+      I8# (word8ToInt8# (orWord8# 17##8 (int8ToWord8# x#)))
+      }
+
+bitAndInt8 = \ x -> case x of { I8# x# -> bitAndInt1 }
+
+bitOrTwoVarInt16
+  = \ x y ->
+      case x of { I16# x# ->
+      case y of { I16# x#1 ->
+      I16#
+        (word16ToInt16#
+           (orWord16#
+              255##16 (orWord16# (int16ToWord16# x#) (int16ToWord16# x#1))))
+      }
+      }
+
+bitAndTwoVarInt16
+  = \ x y ->
+      case x of { I16# x# ->
+      case y of { I16# x#1 ->
+      I16#
+        (word16ToInt16#
+           (andWord16#
+              170##16 (andWord16# (int16ToWord16# x#) (int16ToWord16# x#1))))
+      }
+      }
+
+bitOrInt16
+  = \ x ->
+      case x of { I16# x# ->
+      I16# (word16ToInt16# (orWord16# 255##16 (int16ToWord16# x#)))
+      }
+
+bitAndInt16
+  = \ x ->
+      case x of { I16# x# ->
+      I16# (word16ToInt16# (andWord16# 170##16 (int16ToWord16# x#)))
+      }
+
+bitOrTwoVarInt32
+  = \ x y ->
+      case x of { I32# x# ->
+      case y of { I32# x#1 ->
+      I32#
+        (intToInt32#
+           (orI#
+              (int32ToInt# (intToInt32# (orI# (int32ToInt# x#) 250#)))
+              (int32ToInt# (intToInt32# (orI# (int32ToInt# x#1) 175#)))))
+      }
+      }
+
+bitAndTwoVarInt32
+  = \ x y ->
+      case x of { I32# x# ->
+      case y of { I32# x#1 ->
+      I32#
+        (intToInt32#
+           (andI#
+              (int32ToInt# (intToInt32# (andI# (int32ToInt# x#) 250#)))
+              (int32ToInt# (intToInt32# (andI# (int32ToInt# x#1) 175#)))))
+      }
+      }
+
+bitOrInt32
+  = \ x ->
+      case x of { I32# x# ->
+      I32#
+        (intToInt32#
+           (orI#
+              (int32ToInt# (intToInt32# (orI# (int32ToInt# x#) 250#))) 175#))
+      }
+
+bitAndInt32
+  = \ x ->
+      case x of { I32# x# ->
+      I32#
+        (intToInt32#
+           (andI#
+              (int32ToInt# (intToInt32# (andI# (int32ToInt# x#) 250#))) 175#))
+      }
+
+bitOrTwoVarInt64
+  = \ x y ->
+      case x of { I64# x# ->
+      case y of { I64# x#1 ->
+      I64#
+        (word64ToInt64#
+           (or64# 255##64 (or64# (int64ToWord64# x#) (int64ToWord64# x#1)))) 
+      }
+      }
+
+bitAndTwoVarInt64
+  = \ x y ->
+      case x of { I64# x# ->
+      case y of { I64# x#1 ->
+      I64#
+        (word64ToInt64#
+           (and64# 170##64 (and64# (int64ToWord64# x#) (int64ToWord64# x#1)))) 
+      }
+      }
+
+bitOrInt64
+  = / x ->
+      case x of { I64# x# ->
+      I64# (word64ToInt64# (or64# 255##64 (int64ToWord64# x#)))
+      }
+ 
+bitAndInt64
+  = / x ->
+      case x of { I64# x# ->
+      I64# (word64ToInt64# (and64# 170##64 (int64ToWord64# x#)))
+      }
+
diff --git a/testsuite/tests/simplCore/should_run/T20203.stderr-ws-64 b/testsuite/tests/simplCore/should_run/T20203.stderr-ws-64
new file mode 100644
index 0000000000..1ef5a70af8
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T20203.stderr-ws-64
@@ -0,0 +1,138 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 280, types: 141, coercions: 0, joins: 0/0}
+
+bitOrTwoVarInt
+  = \ x y ->
+      case x of { I# x# ->
+      case y of { I# x#1 -> I# (orI# 255# (orI# x# x#1)) }
+      }
+
+bitAndTwoVarInt
+  = \ x y ->
+      case x of { I# x# ->
+      case y of { I# x#1 -> I# (andI# 170# (andI# x# x#1)) }
+      }
+
+bitOrInt = \ x -> case x of { I# x# -> I# (orI# 255# x#) }
+
+bitAndInt = \ x -> case x of { I# x# -> I# (andI# 170# x#) }
+
+bitOrTwoVarInt8
+  = \ x y ->
+      case x of { I8# x# ->
+      case y of { I8# x#1 ->
+      I8#
+        (word8ToInt8#
+           (orWord8# 17##8 (orWord8# (int8ToWord8# x#) (int8ToWord8# x#1))))
+      }
+      }
+
+bitAndInt1 = I8# 0#8
+
+bitAndTwoVarInt8
+  = \ x y ->
+      case x of { I8# x# -> case y of { I8# x#1 -> bitAndInt1 } }
+
+bitOrInt8
+  = \ x ->
+      case x of { I8# x# ->
+      I8# (word8ToInt8# (orWord8# 17##8 (int8ToWord8# x#)))
+      }
+
+bitAndInt8 = \ x -> case x of { I8# x# -> bitAndInt1 }
+
+bitOrTwoVarInt16
+  = \ x y ->
+      case x of { I16# x# ->
+      case y of { I16# x#1 ->
+      I16#
+        (word16ToInt16#
+           (orWord16#
+              255##16 (orWord16# (int16ToWord16# x#) (int16ToWord16# x#1))))
+      }
+      }
+
+bitAndTwoVarInt16
+  = \ x y ->
+      case x of { I16# x# ->
+      case y of { I16# x#1 ->
+      I16#
+        (word16ToInt16#
+           (andWord16#
+              170##16 (andWord16# (int16ToWord16# x#) (int16ToWord16# x#1))))
+      }
+      }
+
+bitOrInt16
+  = \ x ->
+      case x of { I16# x# ->
+      I16# (word16ToInt16# (orWord16# 255##16 (int16ToWord16# x#)))
+      }
+
+bitAndInt16
+  = \ x ->
+      case x of { I16# x# ->
+      I16# (word16ToInt16# (andWord16# 170##16 (int16ToWord16# x#)))
+      }
+
+bitOrTwoVarInt32
+  = \ x y ->
+      case x of { I32# x# ->
+      case y of { I32# x#1 ->
+      I32#
+        (intToInt32#
+           (orI#
+              (int32ToInt# (intToInt32# (orI# (int32ToInt# x#) 250#)))
+              (int32ToInt# (intToInt32# (orI# (int32ToInt# x#1) 175#)))))
+      }
+      }
+
+bitAndTwoVarInt32
+  = \ x y ->
+      case x of { I32# x# ->
+      case y of { I32# x#1 ->
+      I32#
+        (intToInt32#
+           (andI#
+              (int32ToInt# (intToInt32# (andI# (int32ToInt# x#) 250#)))
+              (int32ToInt# (intToInt32# (andI# (int32ToInt# x#1) 175#)))))
+      }
+      }
+
+bitOrInt32
+  = \ x ->
+      case x of { I32# x# ->
+      I32#
+        (intToInt32#
+           (orI#
+              (int32ToInt# (intToInt32# (orI# (int32ToInt# x#) 250#))) 175#))
+      }
+
+bitAndInt32
+  = \ x ->
+      case x of { I32# x# ->
+      I32#
+        (intToInt32#
+           (andI#
+              (int32ToInt# (intToInt32# (andI# (int32ToInt# x#) 250#))) 175#))
+      }
+
+bitOrTwoVarInt64
+  = \ x y ->
+      case x of { I64# x# ->
+      case y of { I64# x#1 -> I64# (orI# 255# (orI# x# x#1)) }
+      }
+
+bitAndTwoVarInt64
+  = \ x y ->
+      case x of { I64# x# ->
+      case y of { I64# x#1 -> I64# (andI# 170# (andI# x# x#1)) }
+      }
+
+bitOrInt64 = \ x -> case x of { I64# x# -> I64# (orI# 255# x#) }
+
+bitAndInt64 = \ x -> case x of { I64# x# -> I64# (andI# 170# x#) }
+
+
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index a6458ee311..fe6b5d3479 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -98,3 +98,4 @@ test('NumConstantFolding16', normal, compile_and_run, [''])
 test('NumConstantFolding32', normal, compile_and_run, [''])
 test('NumConstantFolding', normal, compile_and_run, [''])
 test('T19413', normal, compile_and_run, [''])
+test('T20203', normal, compile, ['-O -dsuppress-all -dsuppress-uniques -dno-typeable-binds -ddump-simpl'])
\ No newline at end of file