git.iko.soy/generic-lens
on master help sign in
Running PrismBoggle twice optimises away the right calls
c78c1bcMatthew Pickering
generic-lens.cabal+1−1
compare with master
unifiedsplit
@@ -89,7 +89,7 @@ test-suite generic-lens-test
89 ghc-options: -Wall -O2
89 ghc-options: -Wall -O2
90 if flag(dump-core)
90 if flag(dump-core)
91 build-depends: dump-core
91 build-depends: dump-core
92− ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core-html -ddump-to-file -funfolding-use-threshold=100 -fsimpl-tick-factor=0 -ddump-simpl-stats
92+ ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core-html -ddump-to-file -funfolding-use-threshold=1000 -fsimpl-tick-factor=0 -ddump-simpl-stats
93
93
94test-suite doctests
94test-suite doctests
95 default-language: Haskell2010
95 default-language: Haskell2010
src/Data/Generics/Internal/Lens.hs+4−4
@@ -174,12 +174,12 @@ data PrismBoggle p a b where
174instance Choice p => Profunctor (PrismBoggle p) where
174instance Choice p => Profunctor (PrismBoggle p) where
175 dimap f g (Dirty pab) = DMap f g pab
175 dimap f g (Dirty pab) = DMap f g pab
176 dimap f g (DMap f' g' pab) = DMap (f' . f) (g . g') pab
176 dimap f g (DMap f' g' pab) = DMap (f' . f) (g . g') pab
177− dimap f g (DRight pab) = DMap f g (right' pab)
177+ dimap f g (DRight pab) = DMap f g (right' pab)
178
178
179instance Choice p => Choice (PrismBoggle p) where
179instance Choice p => Choice (PrismBoggle p) where
180 right' (Dirty pab) = DRight pab
180 right' (Dirty pab) = DRight pab
181 right' (DMap f g pab) = DMap (fmap f) (fmap g) (right' pab)
181 right' (DMap f g pab) = DMap (fmap f) (fmap g) (right' pab)
182− right' (DRight pab) = DRight (right' pab)
182+ right' (DRight pab) = DMap assoc assoc' (right' pab)
183
183
184assoc :: Either a (Either b c) -> Either (Either a b) c
184assoc :: Either a (Either b c) -> Either (Either a b) c
185assoc e = case e of
185assoc e = case e of
@@ -208,8 +208,8 @@ injPrism (DMap f g pab) = dimap f g pab
208injPrism (DRight pab) = right' pab
208injPrism (DRight pab) = right' pab
209
209
210prismRavel :: (Choice p, Applicative f)
210prismRavel :: (Choice p, Applicative f)
211− => (PrismBoggle p a (Boggle f b) -> PrismBoggle p s (Boggle f t))
211+ => (PrismBoggle (PrismBoggle p) a (Boggle f b) -> PrismBoggle (PrismBoggle p) s (Boggle f t))
212 -> (p a (f b) -> p s (f t))
212 -> (p a (f b) -> p s (f t))
213−prismRavel coy pafb = injPrism (dimap id lowerBoggle (coy (dimap id liftBoggle (projPrism pafb))))
213+prismRavel coy pafb = injPrism (injPrism (dimap id lowerBoggle (coy (dimap id liftBoggle (projPrism (projPrism pafb))))))
214{-# INLINE prismRavel #-}
214{-# INLINE prismRavel #-}
215
215
src/Data/Generics/Sum/Constructors.hs+1−1
@@ -110,7 +110,7 @@ instance
110 , '(t, b) ~ Infer s' a' a (PickTv a' b)
110 , '(t, b) ~ Infer s' a' a (PickTv a' b)
111 ) => AsConstructor ctor s t a b where
111 ) => AsConstructor ctor s t a b where
112
112
113− _Ctor eta = prismRavel (prismRavel (prismRavel (repIso . _GCtor @ctor))) eta
113+ _Ctor eta = prismRavel (repIso . _GCtor @ctor) eta
114 {-# INLINE _Ctor #-}
114 {-# INLINE _Ctor #-}
115
115
116-- See Note [Uncluttering type signatures]
116-- See Note [Uncluttering type signatures]