Embrace -XTypeInType, add -XStarIsType
[ghc.git] / testsuite / tests / simplCore / should_run / simplrun004.hs
1 module Main where
2
3 -- A test for loss of sharing. GHC 6.4.1 did a bogus preInlineUnconditionally
4
5 import Control.Monad ( guard )
6
7 expensive 0 = True
8 expensive 1 = False
9 expensive n = expensive (n-2)
10
11 f g = if expensive (1000000*(fst g)) then odd else even
12
13 ---------------------------------------------------------
14 -- The key point is that the (c g) call should not get pushed inside the \x,
15 -- as happened in 6.4.1. Doing so loses laziness, and this test shows up
16 -- the difference in performance
17 gen_sucW grow c g
18 = \ x -> grow g x >>= \ y -> do guard $ check y; return y
19 where
20 check = c g
21
22 sucW = gen_sucW (\ g x -> map (+x) [fst g..snd g]) f (11,500000)
23
24 main = print (sum $ sucW 11,sum $ sucW 12)
25
26 -- Because this version uses a case expression, the bug
27 -- doesn't happen and execution is much faster
28 gen_sucC grow c g = case c g of
29 check -> \ x -> grow g x >>= \ y -> do guard $ check y; return y
30
31 sucC = gen_sucC (\ g x -> map (+x) [fst g..snd g]) f (11,500000)
32
33 mainC = print (sum $ sucC 11,sum $ sucC 12)
34