on master help sign in
Improve type-checking performance significantly

The algorithm is now a lot clever about avoiding redundant work. There is still quite a bit of redundancy, but caching intermediate values in class parameters seems to have an overall detrimental effect at specialisation

commit67eebf942b024e9215172dcbe77bb058269dff90 authorCsongor Kiss <kiss.csongor.kiss@gmail.com> dateTue 13 Mar 2018, 12:11 (9 years ago) parent0000851
1 file changed+25−20
src/Data/Generics/Product/Types.hs+25−20
src/Data/Generics/Product/Types.hs+25−20
@@ -109,43 +109,48 @@ instance GHasTypes a U1 where
109109 gtypes _ _ = pure U1
110110 {-# INLINE gtypes #-}
111111
112−
113112instance GHasTypes a V1 where
114113 gtypes _ = pure
115114 {-# INLINE gtypes #-}
116115
117−type Interesting f a = Interesting' (Rep f) a '[f]
116+type Interesting f a = Snd (Interesting' (Rep f) a '[f])
118117
119−type family Interesting' f (a :: Type) (seen :: [Type]) :: Bool where
118+type family Interesting' f (a :: Type) (seen :: [Type]) :: ([Type], Bool) where
120119 Interesting' (M1 _ m f) t seen
121120 = Interesting' f t seen
121+ -- The result of the left branch is passed on to the right branch in order to avoid duplicate work
122122 Interesting' (l :*: r) t seen
123− = InterestingOr (Interesting' l t seen) r t seen
123+ = InterestingOr (Interesting' l t seen) r t
124124 Interesting' (l :+: r) t seen
125− = InterestingOr (Interesting' l t seen) r t seen
125+ = InterestingOr (Interesting' l t seen) r t
126126 Interesting' (Rec0 t) t seen
127− = 'True
128− Interesting' (Rec0 Char) _ _ = 'False
129− Interesting' (Rec0 Double) _ _ = 'False
130− Interesting' (Rec0 Float) _ _ = 'False
131− Interesting' (Rec0 Int) _ _ = 'False
132− Interesting' (Rec0 Integer) _ _ = 'False
127+ = '(seen, 'True)
128+ Interesting' (Rec0 Char) _ seen = '(seen ,'False)
129+ Interesting' (Rec0 Double) _ seen = '(seen ,'False)
130+ Interesting' (Rec0 Float) _ seen = '(seen ,'False)
131+ Interesting' (Rec0 Int) _ seen = '(seen ,'False)
132+ Interesting' (Rec0 Integer) _ seen = '(seen ,'False)
133133 Interesting' (Rec0 r) t seen
134− = InterestingUnless (Elem r seen) (Rep r) t (r ': seen)
135− Interesting' _ _ _
136− = 'False
134+ = InterestingUnless (Elem r seen) (Rep r) t r seen
135+ Interesting' _ _ seen
136+ = '(seen, 'False)
137137
138138-- Short circuit
139−type family InterestingUnless (s :: Bool) f (a :: Type) (seen :: [Type]) :: Bool where
140− InterestingUnless 'True _ _ _ = 'False
141− InterestingUnless 'False f a seen = Interesting' f a seen
139+-- Note: we only insert 'r' to the seen list if it's not already there (which is precisely when `s` is 'False)
140+type family InterestingUnless (s :: Bool) f (a :: Type) (r :: Type) (seen :: [Type]) :: ([Type], Bool) where
141+ InterestingUnless 'True _ _ _ seen = '(seen, 'False)
142+ InterestingUnless 'False f a r seen = Interesting' f a (r ': seen)
142143
143144-- Short circuit
144−type family InterestingOr (b :: Bool) r t seen where
145− InterestingOr 'True _ _ _ = 'True
146− InterestingOr 'False r t seen = Interesting' r t seen
145+type family InterestingOr (b :: ([Type], Bool)) r t :: ([Type], Bool) where
146+ InterestingOr '(seen, 'True) _ _ = '(seen, 'True)
147+ InterestingOr '(seen, 'False) r t = Interesting' r t seen
147148
148149type family Elem a as where
149150 Elem a (a ': _) = 'True
150151 Elem a (_ ': as) = Elem a as
151152 Elem a '[] = 'False
153+
154+type family Snd a where
155+ Snd '(_, b) = b
156+