ef002d2 · generic-lens

git.iko.soy/generic-lens

All optimisations are go

commitef002d255d2b9f81048cdc002532ab7a2d33743f authorMatthew Pickering <matthewtpickering@gmail.com> dateThu 25 Jan 2018, 15:35 (9 years ago) parent1e3575e

4 files changed+17−16

compare with master

unifiedsplit

src/Data/Generics/Sum/Internal/Subtype.hs+5−11 src/Data/Generics/Sum/Internal/Typed.hs+7 src/Data/Generics/Sum/Subtype.hs+1−2 test/Spec.hs+4−3

src/Data/Generics/Sum/Internal/Subtype.hs+5−11

@@ -46,8 +46,8 @@ instance

4646 ( GSplash sub sup

4747 , GDowncast sub sup

4848 ) => GAsSubtype sub sup where

49− _GSub f = prismPRavel (prism _GSplash _GDowncast) f

50− {-# INLINE _GSub #-}

49+ _GSub f = (prism _GSplash _GDowncast) f

50+ {-# INLINE[0] _GSub #-}

5151

5252--------------------------------------------------------------------------------

5353

@@ -57,18 +57,15 @@ class GSplash (sub :: Type -> Type) (sup :: Type -> Type) where

5757instance (GSplash a sup, GSplash b sup) => GSplash (a :+: b) sup where

5858 _GSplash (L1 rep) = _GSplash rep

5959 _GSplash (R1 rep) = _GSplash rep

60− {-# INLINE _GSplash #-}

6160

6261instance

6362 ( GIsList () subf subf as as

6463 , GAsType supf as

6564 ) => GSplash (C1 meta subf) supf where

66− _GSplash p = build (prismPRavel (_GTyped . fromIso (glist @()) . fromIso mIso)) p

67− {-# INLINE _GSplash #-}

65+ _GSplash p = build ((_GTyped . fromIso (glist @()) . fromIso mIso)) p

6866

6967instance GSplash sub sup => GSplash (D1 c sub) sup where

7068 _GSplash (M1 m) = _GSplash m

71− {-# INLINE _GSplash #-}

7269

7370--------------------------------------------------------------------------------

7471

@@ -82,7 +79,6 @@ instance

8279 _GDowncast (M1 m) = case _GDowncastC @(HasPartialTypeP as sub) m of

8380 Left _ -> Left (M1 m)

8481 Right r -> Right r

85− {-# INLINE _GDowncast #-}

8682

8783instance (GDowncast sub l, GDowncast sub r) => GDowncast sub (l :+: r) where

8884 _GDowncast (L1 x) = case _GDowncast x of

@@ -91,24 +87,22 @@ instance (GDowncast sub l, GDowncast sub r) => GDowncast sub (l :+: r) where

9187 _GDowncast (R1 x) = case _GDowncast x of

9288 Left _ -> Left (R1 x)

9389 Right r -> Right r

94− {-# INLINE _GDowncast #-}

9590

9691instance GDowncast sub sup => GDowncast sub (D1 m sup) where

9792 _GDowncast (M1 m) = case _GDowncast m of

9893 Left _ -> Left (M1 m)

9994 Right r -> Right r

100− {-# INLINE _GDowncast #-}

10195

10296class GDowncastC (contains :: Bool) sub sup where

10397 _GDowncastC :: sup x -> Either (sup x) (sub x)

10498

10599instance GDowncastC 'False sub sup where

106100 _GDowncastC sup = Left sup

107− {-# INLINE _GDowncastC #-}

108101

109102instance

110103 ( GAsType sub subl

111104 , GIsList () sup sup subl subl

112105 ) => GDowncastC 'True sub sup where

113− _GDowncastC sup = Right (build (prismPRavel (_GTyped . fromIso (glist @()))) sup)

106+ _GDowncastC sup = Right (build (_GTyped . fromIso (glist @())) sup)

114107 {-# INLINE _GDowncastC #-}

108+

src/Data/Generics/Sum/Internal/Typed.hs+7

@@ -29,6 +29,7 @@ module Data.Generics.Sum.Internal.Typed

2929

3030import Data.Kind

3131import GHC.Generics

32+import Data.Tagged

3233

3334import Data.Generics.Internal.Families

3435import Data.Generics.Product.Internal.List

@@ -38,6 +39,12 @@ import Data.Generics.Internal.Profunctor.Prism

3839-- |As 'AsType' but over generic representations as defined by "GHC.Generics".

3940class GAsType (f :: Type -> Type) (as :: [((), Type)]) where

4041 _GTyped :: Prism (f x) (f x) (List as) (List as)

42+-- We create this specialised version as we use it in the subtype prism

43+-- If we don't create it, the opportunity for specialisation is only

44+-- created after specialisation happens, I think a late specialisation pass

45+-- would pick up this case.

46+{-# SPECIALISE _GTyped :: (Tagged b b -> Tagged t t) #-}

47+

4148

4249instance

4350 ( GIsList () f f as as

src/Data/Generics/Sum/Subtype.hs+1−2

@@ -90,7 +90,6 @@ class AsSubtype sub sup where

9090 -- Nothing

9191 _Sub :: Prism' sup sub

9292 _Sub = prism injectSub projectSub

93− {-# INLINE _Sub #-}

9493

9594 -- |Injects a subtype into a supertype (upcast).

9695 injectSub :: sub -> sup

@@ -109,7 +108,7 @@ instance

109108 ) => AsSubtype sub sup where

110109

111110 _Sub f = prismRavel (repIso . _GSub . fromIso repIso) f

112− {-# INLINE _Sub #-}

111+ {-# INLINE[2] _Sub #-}

113112

114113-- See Note [Uncluttering type signatures]

115114instance {-# OVERLAPPING #-} AsSubtype a Void where

test/Spec.hs+4−3

@@ -1,5 +1,5 @@

11{-# OPTIONS_GHC -O -fplugin Test.Inspection.Plugin #-}

2−{-# OPTIONS_GHC -dsuppress-unfoldings #-}

2+{-# OPTIONS_GHC -dsuppress-all #-}

44{-# LANGUAGE AllowAmbiguousTypes #-}

55{-# LANGUAGE DataKinds #-}

@@ -127,14 +127,15 @@ sum2PrismManualChar eta = prism g f eta

127127 s -> Left s

128128 g = A2

129129

130−

130+-- Note we don't have a catch-all case because of #14684

131131subtypePrismManual :: Prism Sum1 Sum1 Sum2 Sum2

132132subtypePrismManual eta = prism g f eta

133133 where

134134 f s1 = case s1 of

135135 A c -> Right (A2 c)

136136 B i -> Right (B2 i)

137− _ -> Left s1

137+ C _ -> Left s1

138+ D _ -> Left s1

138139 g (A2 c) = A c

139140 g (B2 i) = B i

140141