CprAnal: Two regression tests

For #16040 and #2387.

testsuite/tests/cpranal/sigs/T16040.hs

+{-# LANGUAGE BangPatterns #-}
+
+module T16040 where
+
+-- A type to take the place of state
+data X a = X { runX :: !a }
+
+test1 :: Int -> Int
+test1 = \(!i) -> go i where
+    go = \(!i) -> if i > 0
+        then go $! i - 1
+        else i
+{-# NOINLINE test1 #-}
+
+-- | Like 'test1', this function's result should have the CPR property and be
+-- unboxed.
+test2 :: Int -> Int
+test2 = \(!i) -> runX (go i) where
+    go = \(!i) -> if i > 0
+        then go $! i - 1
+        else X i
+{-# NOINLINE test2 #-}

testsuite/tests/cpranal/sigs/T16040.stderr

+
+==================== Cpr signatures ====================
+T16040.runX:
+T16040.test1: 1
+T16040.test2: 1
+
+

testsuite/tests/cpranal/sigs/T2387.hs

+{-# LANGUAGE TypeOperators, BangPatterns #-}
+
+module T2387 (mainLoop) where
+
+import Control.Monad.ST
+
+import System.Environment
+
+data (:*:) a b = !a :*: !b
+
+whileLoop :: Int -> ST s Int
+whileLoop = go 0
+ where
+ go !n k
+   | k == 0    = return n
+   | otherwise = go (n+1) (k-1)
+{-# INLINE whileLoop #-}
+
+iter :: Int -> Int -> ST s (Bool :*: Int)
+iter k n = do
+  k' <- whileLoop 40 >>= \k' -> return $! max k k'
+  b <- return (n == 0)
+
+  return $! b :*: k'
+{-# INLINE iter #-}
+
+-- | The returned Int should be unboxed
+mainLoop :: Int -> Int -> ST s Int
+mainLoop k n = do
+  done :*: k' <- iter k n
+
+  if done
+    then return k'
+    else mainLoop k' (n - 1)

testsuite/tests/cpranal/sigs/T2387.stderr

+
+==================== Cpr signatures ====================
+T2387.mainLoop: 1(, 1)
+
+

testsuite/tests/cpranal/sigs/all.T

@@ -7,6 +7,8 @@ setTestOpts(extra_hc_opts('-dno-typeable-binds -ddump-cpr-signatures -v0'))
 
 test('CaseBinderCPR', normal, compile, [''])
 test('RecDataConCPR', [], multimod_compile, ['RecDataConCPR', ''])
+test('T2387', normal, compile, [''])
+test('T16040', normal, compile, [''])
 test('T19232', normal, compile, [''])
 test('T19398', normal, compile, [''])
 test('T19822', normal, compile, [''])