git.iko.soy/generic-lens
on master help sign in
Running PrismBoggle twice optimises away the right calls

The core is not identical as we also need to apply the identity dimap id h k = dimap g id l => dimap id (either f h) (right k) = dimap (either f g) id (right l) in order to remove the wrapping and unwrapping of the left argument.

commitc78c1bc657b5cc4d847a94ed7bc9a182fb1eea8b authorMatthew Pickering <matthewtpickering@gmail.com> dateThu 21 Dec 2017, 13:44 (9 years ago) parentdb73962
3 files changed+6−6
compare with master
unifiedsplit
generic-lens.cabal+1−1 src/Data/Generics/Internal/Lens.hs+4−4 src/Data/Generics/Sum/Constructors.hs+1−1
generic-lens.cabal+1−1
@@ -89,7 +89,7 @@ test-suite generic-lens-test
8989 ghc-options: -Wall -O2
9090 if flag(dump-core)
9191 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
9393
9494test-suite doctests
9595 default-language: Haskell2010
src/Data/Generics/Internal/Lens.hs+4−4
@@ -174,12 +174,12 @@ data PrismBoggle p a b where
174174instance Choice p => Profunctor (PrismBoggle p) where
175175 dimap f g (Dirty pab) = DMap f g pab
176176 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)
178178
179179instance Choice p => Choice (PrismBoggle p) where
180180 right' (Dirty pab) = DRight pab
181181 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)
183183
184184assoc :: Either a (Either b c) -> Either (Either a b) c
185185assoc e = case e of
@@ -208,8 +208,8 @@ injPrism (DMap f g pab) = dimap f g pab
208208injPrism (DRight pab) = right' pab
209209
210210prismRavel :: (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))
212212 -> (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))))))
214214{-# INLINE prismRavel #-}
215215
src/Data/Generics/Sum/Constructors.hs+1−1
@@ -110,7 +110,7 @@ instance
110110 , '(t, b) ~ Infer s' a' a (PickTv a' b)
111111 ) => AsConstructor ctor s t a b where
112112
113− _Ctor eta = prismRavel (prismRavel (prismRavel (repIso . _GCtor @ctor))) eta
113+ _Ctor eta = prismRavel (repIso . _GCtor @ctor) eta
114114 {-# INLINE _Ctor #-}
115115
116116-- See Note [Uncluttering type signatures]