Update Trac ticket URLs to point to GitLab
[ghc.git] / testsuite / tests / stranal / should_compile / T10482a.hs
1 {-# LANGUAGE TypeFamilies #-}
2 {-# OPTIONS_GHC -fno-unbox-small-strict-fields #-}
3 -- Makes f2 a bit more challenging
4
5 -- Tests inspired by Note [CPR examples] in DmdAnal, and #10482
6
7 module Foo where
8
9
10 h :: Int -> Int -> Bool
11 h 0 y = y>0
12 h n y = h (n-1) y
13
14 -- The main point: all of these functions can have the CPR property
15
16 ------- f1 -----------
17 -- x is used strictly by h, so it'll be available
18 -- unboxed before it is returned in the True branch
19
20 f1 :: Int -> Int
21 f1 x = case h x x of
22 True -> x
23 False -> f1 (x-1)
24
25
26 ------- f2 -----------
27 -- x is a strict field of MkT2, so we'll pass it unboxed
28 -- to $wf2, so it's available unboxed. This depends on
29 -- the case expression analysing (a subcomponent of) one
30 -- of the original arguments to the function, so it's
31 -- a bit more delicate.
32
33 data T2 = MkT2 !Int Int
34
35 f2 :: T2 -> Int
36 f2 (MkT2 x y) | y>0 = f2 (MkT2 x (y-1))
37 | y>1 = 1
38 | otherwise = x
39
40
41 ------- f3 -----------
42 -- h is strict in x, so x will be unboxed before it
43 -- is rerturned in the otherwise case.
44
45 data T3 = MkT3 Int Int
46
47 f3 :: T3 -> Int
48 f3 (MkT3 x y) | h x y = f3 (MkT3 x (y-1))
49 | otherwise = x
50
51
52 ------- f4 -----------
53 -- Just like f2, but MkT4 can't unbox its strict
54 -- argument automatically, as f2 can
55
56 data family Foo a
57 newtype instance Foo Int = Foo Int
58
59 data T4 a = MkT4 !(Foo a) Int
60
61 f4 :: T4 Int -> Int
62 f4 (MkT4 x@(Foo v) y) | y>0 = f4 (MkT4 x (y-1))
63 | otherwise = v