on master help sign in
Improve type-checking performance significantly
67eebf9Csongor Kiss
src/Data/Generics/Product/Types.hs+25−20
@@ -109,43 +109,48 @@ instance GHasTypes a U1 where
109 gtypes _ _ = pure U1
109 gtypes _ _ = pure U1
110 {-# INLINE gtypes #-}
110 {-# INLINE gtypes #-}
111
111
112−
113instance GHasTypes a V1 where
112instance GHasTypes a V1 where
114 gtypes _ = pure
113 gtypes _ = pure
115 {-# INLINE gtypes #-}
114 {-# INLINE gtypes #-}
116
115
117−type Interesting f a = Interesting' (Rep f) a '[f]
116+type Interesting f a = Snd (Interesting' (Rep f) a '[f])
118
117
119−type family Interesting' f (a :: Type) (seen :: [Type]) :: Bool where
118+type family Interesting' f (a :: Type) (seen :: [Type]) :: ([Type], Bool) where
120 Interesting' (M1 _ m f) t seen
119 Interesting' (M1 _ m f) t seen
121 = Interesting' f t seen
120 = Interesting' f t seen
121+ -- The result of the left branch is passed on to the right branch in order to avoid duplicate work
122 Interesting' (l :*: r) t seen
122 Interesting' (l :*: r) t seen
123− = InterestingOr (Interesting' l t seen) r t seen
123+ = InterestingOr (Interesting' l t seen) r t
124 Interesting' (l :+: r) t seen
124 Interesting' (l :+: r) t seen
125− = InterestingOr (Interesting' l t seen) r t seen
125+ = InterestingOr (Interesting' l t seen) r t
126 Interesting' (Rec0 t) t seen
126 Interesting' (Rec0 t) t seen
127− = 'True
127+ = '(seen, 'True)
128− Interesting' (Rec0 Char) _ _ = 'False
128+ Interesting' (Rec0 Char) _ seen = '(seen ,'False)
129− Interesting' (Rec0 Double) _ _ = 'False
129+ Interesting' (Rec0 Double) _ seen = '(seen ,'False)
130− Interesting' (Rec0 Float) _ _ = 'False
130+ Interesting' (Rec0 Float) _ seen = '(seen ,'False)
131− Interesting' (Rec0 Int) _ _ = 'False
131+ Interesting' (Rec0 Int) _ seen = '(seen ,'False)
132− Interesting' (Rec0 Integer) _ _ = 'False
132+ Interesting' (Rec0 Integer) _ seen = '(seen ,'False)
133 Interesting' (Rec0 r) t seen
133 Interesting' (Rec0 r) t seen
134− = InterestingUnless (Elem r seen) (Rep r) t (r ': seen)
134+ = InterestingUnless (Elem r seen) (Rep r) t r seen
135− Interesting' _ _ _
135+ Interesting' _ _ seen
136− = 'False
136+ = '(seen, 'False)
137
137
138-- Short circuit
138-- Short circuit
139+-- Note: we only insert 'r' to the seen list if it's not already there (which is precisely when `s` is 'False)
139−type family InterestingUnless (s :: Bool) f (a :: Type) (seen :: [Type]) :: Bool where
140+type family InterestingUnless (s :: Bool) f (a :: Type) (r :: Type) (seen :: [Type]) :: ([Type], Bool) where
140− InterestingUnless 'True _ _ _ = 'False
141+ InterestingUnless 'True _ _ _ seen = '(seen, 'False)
141− InterestingUnless 'False f a seen = Interesting' f a seen
142+ InterestingUnless 'False f a r seen = Interesting' f a (r ': seen)
142
143
143-- Short circuit
144-- Short circuit
144−type family InterestingOr (b :: Bool) r t seen where
145+type family InterestingOr (b :: ([Type], Bool)) r t :: ([Type], Bool) where
145− InterestingOr 'True _ _ _ = 'True
146+ InterestingOr '(seen, 'True) _ _ = '(seen, 'True)
146− InterestingOr 'False r t seen = Interesting' r t seen
147+ InterestingOr '(seen, 'False) r t = Interesting' r t seen
147
148
148type family Elem a as where
149type family Elem a as where
149 Elem a (a ': _) = 'True
150 Elem a (a ': _) = 'True
150 Elem a (_ ': as) = Elem a as
151 Elem a (_ ': as) = Elem a as
151 Elem a '[] = 'False
152 Elem a '[] = 'False
153+
154+type family Snd a where
155+ Snd '(_, b) = b
156+