[Git][ghc/ghc][wip/nested-cpr-2019] Fix T1600

[Sebastian Graf]

Sebastian Graf pushed to branch wip/nested-cpr-2019 at Glasgow Haskell Compiler / GHC


Commits:
fec46cbb by Sebastian Graf at 2020-04-23T21:10:51+02:00
Fix T1600

- - - - -


2 changed files:

- testsuite/tests/cpranal/sigs/T1600.hs
- testsuite/tests/cpranal/sigs/T1600.stderr


Changes:

=====================================
testsuite/tests/cpranal/sigs/T1600.hs
=====================================
@@ -1,20 +1,23 @@
-module T1600 where
+module Lib where
 
 
 -- pretty strict
-fac :: Int -> a ->  (a, Int)
-fac n s | n < 2     = (s,1)
-        | otherwise = case  fac (n-1) s of (s',n') -> let n'' = n*n' in n'' `seq` (s',n'')
+fac1 :: Int -> a ->  (a, Int)
+fac1 n s | n < 2     = (s,1)
+         | otherwise = case  fac1 (n-1) s of (s',n') -> let n'' = n*n' in n'' `seq` (s',n'')
 
 -- lazier, but Int still has CPR
 fac2 :: Int -> a ->  (a, Int)
 fac2 n s | n < 2     = (s,1)
-         | otherwise = case  fac (n-1) s of (s',n') -> (s',n'*n')
+         | otherwise = case  fac2 (n-1) s of (s',n') -> (s',n'*n')
 
--- even lazier, no CPR on Int
+-- even lazier, but evaluation of the Int doesn't terminate rapidly!
+-- Thus, we may not WW for the nested Int.
+-- Otherwise @fac3 99999 () `seq` ()@ (which should terminate rapidly)
+-- evaluates more than necessary.
 fac3 :: Int -> a ->  (a, Int)
 fac3 n s | n < 2     = (s,1)
-         | otherwise = let (s',n') = fac (n-1) s in (s',n'*n')
+         | otherwise = let (s',n') = fac3 (n-1) s in (s',n'*n')
 
 facIO :: Int -> IO Int
 facIO n | n < 2     = return 1


=====================================
testsuite/tests/cpranal/sigs/T1600.stderr
=====================================
@@ -1,7 +1,9 @@
 
 ==================== Cpr signatures ====================
-FacState.$trModule: #1(#, #) 1(1(-), 1(-))
-FacState.fac: *1(*, #) 1(-, 1(-))
-FacState.facIO: *1(*, #) 1(-, 1(-))
+Lib.$trModule: #c1(#c1(#), #c1(#))
+Lib.fac1: *c1(*, #c1(#))
+Lib.fac2: *c1(*, #c1(#))
+Lib.fac3: *c1(*, *c1(#))
+Lib.facIO: *c1(*, #c1(#))
 
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fec46cbba409e405f49d1aade0ad5f639a1632e4

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fec46cbba409e405f49d1aade0ad5f639a1632e4
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200423/7837918d/attachment-0001.html>