Update Trac ticket URLs to point to GitLab
[ghc.git] / testsuite / tests / simplCore / should_run / T3403.hs
1 {-# LANGUAGE BangPatterns #-}
2
3
4 -- See #3403: interaction of pattern match failure and CPR
5 -- The point is that this should run in constant space, with no
6 -- stack growth. In GHC 6.10 the tail call optimisation didn't work.
7
8 module Main (main) where
9
10 import qualified Data.Set as Set
11 import Data.Set (Set)
12
13 data Result = Result !S1 !S2
14
15 type S1 = Set ()
16 type S2 = Set ()
17
18 input :: [[(Int, ())]]
19 input = replicate 1000 (replicate 400 (100, ()))
20
21 main :: IO ()
22 main = do let Result s1 s2 = doAll Set.empty Set.empty () input
23 print $ Set.size s1
24 print $ Set.size s2
25
26 doAll :: S1 -> S2 -> () -> [[(Int, ())]] -> Result
27 doAll !s1 !s2 !_ [] = Result s1 s2
28 doAll !s1 !s2 !unit ([] : xs) = doAll s1 s2 unit xs
29 doAll !s1 !s2 !unit (((t, _) : x1) : x2 : xs)
30 | t >= 99999 = doAll s1 s2 unit (x1 : x2 : xs)
31 doAll !s1 !s2 !unit (((_, ()) : x) : xs)
32 = doAll s1 s2 unit (x : xs)