hadrian: Throw error on duplicate-named flavours
[ghc.git] / testsuite / tests / perf / should_run / T4267.hs
1 data Tree a = Leaf | Node a !(Tree a) !(Tree a)
2
3 {-
4
5 This should produce a walker with unboxed integers.
6
7 Bad:
8
9 Rec {
10 go_r1us
11 :: GHC.Types.Int -> Main.Tree GHC.Types.Int -> GHC.Types.Int
12 [GblId, Arity=2, Caf=NoCafRefs, Str=SS]
13 go_r1us =
14 \ (z_aeS :: GHC.Types.Int) (ds_dmD :: Main.Tree GHC.Types.Int) ->
15 case ds_dmD of _ {
16 Main.Leaf -> z_aeS;
17 Main.Node a1_aeU l_aeV r_aeW ->
18 case go_r1us z_aeS l_aeV of _ { GHC.Types.I# ipv_snn ->
19 case a1_aeU of _ { GHC.Types.I# y_anh ->
20 go_r1us (GHC.Types.I# (GHC.Prim.+# ipv_snn y_anh)) r_aeW
21 }
22 }
23 }
24 end Rec }
25
26
27 Good:
28
29 Rec {
30 $wgo_r2fS
31 :: GHC.Prim.Int# -> Main.Tree GHC.Types.Int -> GHC.Prim.Int#
32 [GblId, Arity=2, Caf=NoCafRefs, Str=<L,U><S,1*U>]
33 $wgo_r2fS =
34 \ (ww_s2eZ :: GHC.Prim.Int#) (w_s2eW :: Main.Tree GHC.Types.Int) ->
35 case w_s2eW of _ [Occ=Dead] {
36 Main.Leaf -> ww_s2eZ;
37 Main.Node a1_aqv l_aqw r_aqx ->
38 case $wgo_r2fS ww_s2eZ l_aqw of ww1_s2f3 { __DEFAULT ->
39 case a1_aqv of _ [Occ=Dead] { GHC.Types.I# y_aTz ->
40 $wgo_r2fS (GHC.Prim.+# ww1_s2f3 y_aTz) r_aqx
41 }
42 }
43 }
44 end Rec }
45
46 -}
47
48 -- Strict, pre-order fold.
49 fold' :: (a -> b -> a) -> a -> Tree b -> a
50 fold' f = go
51 where
52 go z Leaf = z
53 go z (Node a l r) = let z' = go z l
54 z'' = f z' a
55 in z' `seq` z'' `seq` go z'' r
56
57
58 sumTree :: Int -> Tree Int -> Int
59 sumTree = fold' (+)
60
61
62 tree = Node 0 (Node 0 Leaf Leaf) (Node 0 Leaf Leaf)
63
64 main = sum [sumTree n tree | n <- [0..1000]] `seq` return ()