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