Bump a few more performance regressions from Type-indexed Typeable
[ghc.git] / testsuite / tests / perf / compiler / T13035.hs
1 {-# LANGUAGE PolyKinds, DataKinds, TypeOperators, TypeFamilies, GADTs, PartialTypeSignatures #-}
2
3 module T13035 where
4
5 newtype MyAttr a b = MyAttr { _unMyAttr :: MyFun (a b) }
6 type MyRec a b = Rec (MyAttr a) b
7
8 type family MyFun (a :: k1) :: k2
9
10 data GY (a :: k1) (b :: k2) (c :: k1 -> k3) (d :: k1)
11 data GNone (a :: k1)
12
13 type family GYTF a where
14 GYTF (GY a b _ a) = b
15 GYTF (GY _ _ c d) = MyFun (c d)
16
17 type instance MyFun (GY a b c d) = GYTF (GY a b c d)
18
19 type family GNoneTF (a :: k1) :: k2 where
20
21 type instance MyFun (GNone a) = GNoneTF a
22
23 type (a :: k1) =: (b :: k2) = a `GY` b
24 type (a :: j1 -> j2) $ (b :: j1) = a b
25
26 infixr 0 $
27 infixr 9 =:
28
29 data FConst (a :: *) (b :: Fields)
30 data FApply (a :: * -> * -> *) b c (d :: Fields)
31 data FMap (a :: * -> *) b (d :: Fields)
32
33 type instance MyFun (FConst a b) = a
34 type instance MyFun (FApply b c d a) = b (MyFun (c a)) (MyFun (d a))
35 type instance MyFun (FMap b c a) = b (MyFun (c a))
36
37 data Fields = Name
38 | Author
39 | Image
40 | Description
41 | Ingredients
42 | Instructions
43 | CookTime
44 | PrepTime
45 | TotalTime
46 | Yield
47 | Nutrition
48 | Tags
49 | Url
50 | Section
51 | Items
52 | Subsections
53 | Calories
54 | Carbohydrates
55 | Cholesterol
56 | Fat
57 | Fiber
58 | Protien
59 | SaturatedFat
60 | Sodium
61 | Sugar
62 | TransFat
63 | UnsaturatedFat
64 | ServingSize
65
66 data Rec :: (u -> *) -> [u] -> * where
67 RNil :: Rec f '[]
68 (:&) :: !(f r) -> !(Rec f rs) -> Rec f (r ': rs)
69
70 data family Sing (a :: k)
71 data instance Sing (z_a6bn :: Fields)
72 = z_a6bn ~ Name => SName |
73 z_a6bn ~ Author => SAuthor |
74 z_a6bn ~ Image => SImage |
75 z_a6bn ~ Description => SDescription |
76 z_a6bn ~ Ingredients => SIngredients |
77 z_a6bn ~ Instructions => SInstructions |
78 z_a6bn ~ CookTime => SCookTime |
79 z_a6bn ~ PrepTime => SPrepTime |
80 z_a6bn ~ TotalTime => STotalTime |
81 z_a6bn ~ Yield => SYield |
82 z_a6bn ~ Nutrition => SNutrition |
83 z_a6bn ~ Tags => STags |
84 z_a6bn ~ Url => SUrl |
85 z_a6bn ~ Section => SSection |
86 z_a6bn ~ Items => SItems |
87 z_a6bn ~ Subsections => SSubsections |
88 z_a6bn ~ Calories => SCalories |
89 z_a6bn ~ Carbohydrates => SCarbohydrates |
90 z_a6bn ~ Cholesterol => SCholesterol |
91 z_a6bn ~ Fat => SFat |
92 z_a6bn ~ Fiber => SFiber |
93 z_a6bn ~ Protien => SProtien |
94 z_a6bn ~ SaturatedFat => SSaturatedFat |
95 z_a6bn ~ Sodium => SSodium |
96 z_a6bn ~ Sugar => SSugar |
97 z_a6bn ~ TransFat => STransFat |
98 z_a6bn ~ UnsaturatedFat => SUnsaturatedFat |
99 z_a6bn ~ ServingSize => SServingSize
100
101 (=::) :: sing f -> MyFun (a f) -> MyAttr a f
102 _ =:: x = MyAttr x
103
104 type NutritionT
105 = Calories =: Maybe Int
106 $ Carbohydrates =: Maybe Int
107 $ Cholesterol =: Maybe Int
108 $ Fat =: Maybe Int
109 $ Fiber =: Maybe Int
110 $ Protien =: Maybe Int
111 $ SaturatedFat =: Maybe Int
112 $ Sodium =: Maybe Int
113 $ Sugar =: Maybe Int
114 $ TransFat =: Maybe Int
115 $ UnsaturatedFat =: Maybe Int
116 $ ServingSize =: String
117 $ GNone
118
119 type NutritionRec = MyRec NutritionT ['Calories, 'Carbohydrates,
120 'Cholesterol, 'Fat, 'Fiber,
121 'Protien, 'SaturatedFat, 'Sodium,
122 'Sugar, 'TransFat, 'UnsaturatedFat,
123 'ServingSize]
124
125 type RecipeT
126 = Name =: String
127 $ Author =: String
128 $ Image =: String
129 $ Description =: String
130 $ CookTime =: Maybe Int
131 $ PrepTime =: Maybe Int
132 $ TotalTime =: Maybe Int
133 $ Yield =: String
134 $ Nutrition =: NutritionRec
135 $ Tags =: [String]
136 $ Url =: String
137 $ GNone
138
139 type RecipeFormatter = FApply (->) (FConst [String]) (FMap IO RecipeT)
140
141 g :: MyRec RecipeFormatter _ --'[ 'Author ] Uncomment to prevent loop
142 g = SAuthor =:: (\a -> return "Hi")
143 :& RNil