Add quot folding rule (#22152)

   (x / l1) / l2
   l1 and l2 /= 0
   l1*l2 doesn't overflow
   ==> x / (l1 * l2)

4 files changed, 88 insertions, 3 deletions

diff --git a/testsuite/tests/primops/should_compile/T22152.stderr b/testsuite/tests/primops/should_compile/T22152.stderr
index 505bca04a7..33ff7721f6 100644
--- a/testsuite/tests/primops/should_compile/T22152.stderr
+++ b/testsuite/tests/primops/should_compile/T22152.stderr
@@ -1,10 +1,9 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 11, types: 5, coercions: 0, joins: 0/0}
+  = {terms: 9, types: 5, coercions: 0, joins: 0/0}
 
-toHours
-  = \ t -> case t of { I# x -> I# (quotInt# (quotInt# x 60#) 60#) }
+toHours = \ t -> case t of { I# x -> I# (quotInt# x 3600#) }
 
 
 
diff --git a/testsuite/tests/primops/should_compile/T22152b.hs b/testsuite/tests/primops/should_compile/T22152b.hs
new file mode 100644
index 0000000000..f6ee4fce28
--- /dev/null
+++ b/testsuite/tests/primops/should_compile/T22152b.hs
@@ -0,0 +1,38 @@
+{-# OPTIONS_GHC -O2 -ddump-simpl -dno-typeable-binds -dsuppress-all -dsuppress-uniques #-}
+module T22152b where
+
+import Data.Int
+import Data.Word
+
+a :: Int32 -> Int32
+a x = (x `quot` maxBound) `quot` maxBound -- overflow, mustn't trigger the rewrite rule
+
+b :: Int -> Int
+b x = (x `quot` 10) `quot` 20
+
+c :: Word -> Word
+c x = (x `quot` 10) `quot` 20
+
+d :: Word8 -> Word8
+d x = (x `quot` 10) `quot` 20
+
+e :: Word16 -> Word16
+e x = (x `quot` 10) `quot` 20
+
+f :: Word32 -> Word32
+f x = (x `quot` 10) `quot` 20
+
+g :: Word64 -> Word64
+g x = (x `quot` 10) `quot` 20
+
+h :: Int8 -> Int8
+h x = (x `quot` 10) `quot` 20
+
+i :: Int16 -> Int16
+i x = (x `quot` 10) `quot` 20
+
+j :: Int32 -> Int32
+j x = (x `quot` 10) `quot` 20
+
+k :: Int64 -> Int64
+k x = (x `quot` 10) `quot` 20
diff --git a/testsuite/tests/primops/should_compile/T22152b.stderr b/testsuite/tests/primops/should_compile/T22152b.stderr
new file mode 100644
index 0000000000..0cf317cc32
--- /dev/null
+++ b/testsuite/tests/primops/should_compile/T22152b.stderr
@@ -0,0 +1,47 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 119, types: 59, coercions: 0, joins: 0/0}
+
+b = \ x -> case x of { I# x1 -> I# (quotInt# x1 200#) }
+
+c = \ x -> case x of { W# x# -> W# (quotWord# x# 200##) }
+
+d = \ x -> case x of { W8# x# -> W8# (quotWord8# x# 200#Word8) }
+
+e = \ x ->
+      case x of { W16# x# -> W16# (quotWord16# x# 200#Word16) }
+
+f = \ x ->
+      case x of { W32# x# -> W32# (quotWord32# x# 200#Word32) }
+
+g = \ x ->
+      case x of { W64# x# ->
+      case quotWord64# x# 10#Word64 of ds1 { __DEFAULT ->
+      case quotWord64# ds1 20#Word64 of ds2 { __DEFAULT -> W64# ds2 }
+      }
+      }
+
+h = \ x ->
+      case x of { I8# x# ->
+      I8# (quotInt8# (quotInt8# x# 10#Int8) 20#Int8)
+      }
+
+i = \ x -> case x of { I16# x# -> I16# (quotInt16# x# 200#Int16) }
+
+j = \ x -> case x of { I32# x# -> I32# (quotInt32# x# 200#Int32) }
+
+a = \ x ->
+      case x of { I32# x# ->
+      I32# (quotInt32# (quotInt32# x# 2147483647#Int32) 2147483647#Int32)
+      }
+
+k = \ x ->
+      case x of { I64# x# ->
+      case quotInt64# x# 10#Int64 of ds { __DEFAULT ->
+      case quotInt64# ds 20#Int64 of ds1 { __DEFAULT -> I64# ds1 }
+      }
+      }
+
+
+
diff --git a/testsuite/tests/primops/should_compile/all.T b/testsuite/tests/primops/should_compile/all.T
index 94ef2b5c4f..9ba0fe40e8 100644
--- a/testsuite/tests/primops/should_compile/all.T
+++ b/testsuite/tests/primops/should_compile/all.T
@@ -7,3 +7,4 @@ test('UnliftedMutVar_Comp', normal, compile, [''])
 test('UnliftedStableName', normal, compile, [''])
 test('KeepAliveWrapper', normal, compile, ['-O'])
 test('T22152', normal, compile, [''])
+test('T22152b', normal, compile, [''])