git.iko.soy/generic-lens
on master help sign in
Fix inlining on GHC 8.0.2

As pointed out in (#15), GHC 8.0.2 didn't optimise the lenses as efficiently as 8.2. This was fixed by specialising the mIso and repIso functions to lenses, and eta-expanding the definitions.

commit8f1c61e617a62173b99af532900b643289e08666 authorCsongor Kiss <kiss.csongor.kiss@gmail.com> dateFri 10 Nov 2017, 19:20 (9 years ago) parent85974a2
9 files changed+16−16
compare with master
unifiedsplit
src/Data/Generics/Internal/Lens.hs+7 src/Data/Generics/Product/Fields.hs+1−1 src/Data/Generics/Product/Internal/Fields.hs+3−3 src/Data/Generics/Product/Internal/Positions.hs+1−1 src/Data/Generics/Product/Internal/Typed.hs+1−1 src/Data/Generics/Product/Positions.hs+1−1 src/Data/Generics/Product/Typed.hs+1−1 stack.yaml+1−1 test/Spec.hs−7
src/Data/Generics/Internal/Lens.hs+7
@@ -77,6 +77,13 @@ repIso = dimap from (fmap to)
7777mIso :: Iso' (M1 i c f p) (f p)
7878mIso = dimap unM1 (fmap M1)
7979
80+-- These are specialised versions of the Isos above. On GHC 8.0.2, having
81+-- these functions eta-expanded allows the optimiser to inline these functions.
82+mLens :: Lens' (M1 i c f p) (f p)
83+mLens f s = mIso f s
84+
85+repLens :: Generic a => Lens' a (Rep a x)
86+repLens f s = repIso f s
8087
8188sumIso :: Iso' ((a :+: b) x) (Either (a x) (b x))
8289sumIso = dimap f (fmap t)
src/Data/Generics/Product/Fields.hs+1−1
@@ -91,7 +91,7 @@ instance
9191 , GHasField field (Rep s) a
9292 ) => HasField field a s where
9393
94− field = ravel (repIso . gfield @field)
94+ field = ravel (repLens . gfield @field)
9595
9696type family ErrorUnless (field :: Symbol) (s :: Type) (contains :: Bool) :: Constraint where
9797 ErrorUnless field s 'False
src/Data/Generics/Product/Internal/Fields.hs+3−3
@@ -53,13 +53,13 @@ instance GHasField field (K1 R a) a where
5353 gfield f (K1 x) = fmap K1 (f x)
5454
5555instance GHasField field (S1 ('MetaSel ('Just field) upkd str infstr) (Rec0 a)) a where
56− gfield = mIso . gfield @field
56+ gfield = mLens . gfield @field
5757
5858instance GHasField field f a => GHasField field (M1 D meta f) a where
59− gfield = mIso . gfield @field
59+ gfield = mLens . gfield @field
6060
6161instance GHasField field f a => GHasField field (M1 C meta f) a where
62− gfield = mIso . gfield @field
62+ gfield = mLens . gfield @field
6363
6464class GProductHasField (field :: Symbol) l r a (left :: Bool) | left field l r -> a where
6565 gproductField :: Lens' ((l :*: r) x) a
src/Data/Generics/Product/Internal/Positions.hs+1−1
@@ -46,7 +46,7 @@ instance GHasPosition i i (K1 R a) a where
4646 gposition f (K1 x) = fmap K1 (f x)
4747
4848instance GHasPosition offset i f a => GHasPosition offset i (M1 m meta f) a where
49− gposition = mIso . gposition @offset @i
49+ gposition = mLens . gposition @offset @i
5050
5151instance
5252 ( goLeft ~ (i <? (offset + Size l))
src/Data/Generics/Product/Internal/Typed.hs+1−1
@@ -50,7 +50,7 @@ instance GHasType (K1 R a) a where
5050 gtyped f (K1 x) = fmap K1 (f x)
5151
5252instance GHasType f a => GHasType (M1 m meta f) a where
53− gtyped = mIso . gtyped
53+ gtyped = mLens . gtyped
5454
5555class GProductHasType l r a (contains :: Bool) where
5656 gproductTyped :: Lens' ((l :*: r) x) a
src/Data/Generics/Product/Positions.hs+1−1
@@ -93,7 +93,7 @@ instance
9393 , GHasPosition 1 i (Rep s) a
9494 ) => HasPosition i a s where
9595
96− position = ravel (repIso . gposition @1 @i)
96+ position = ravel (repLens . gposition @1 @i)
9797
9898type family ErrorUnless (i :: Nat) (s :: Type) (hasP :: Bool) :: Constraint where
9999 ErrorUnless i s 'False
src/Data/Generics/Product/Typed.hs+1−1
@@ -83,7 +83,7 @@ instance
8383 , GHasType (Rep s) a
8484 ) => HasType a s where
8585
86− typed = ravel (repIso . gtyped)
86+ typed = ravel (repLens . gtyped)
8787
8888type family ErrorUnlessOne (a :: Type) (s :: Type) (count :: Count) :: Constraint where
8989 ErrorUnlessOne a s 'None
stack.yaml+1−1
@@ -1,4 +1,4 @@
1−resolver: nightly-2017-09-06
1+resolver: lts-9.12
22
33packages:
44- '.'
test/Spec.hs−7
@@ -9,15 +9,12 @@
99{-# LANGUAGE ScopedTypeVariables #-}
1010{-# LANGUAGE TypeApplications #-}
1111{-# LANGUAGE TemplateHaskell #-}
12−{-# LANGUAGE CPP #-}
1312
1413module Main where
1514
1615import GHC.Generics
1716import Data.Generics.Product
18−#if MIN_VERSION_GLASGOW_HASKELL(8,2,0,0)
1917import Test.Inspection
20−#endif
2118
2219main :: IO ()
2320main = putStrLn "Hello world"
@@ -63,11 +60,7 @@ fieldALensPos = position @1
6360subtypeLensGeneric :: Lens' Record Record2
6461subtypeLensGeneric = super
6562
66−#if MIN_VERSION_GLASGOW_HASKELL(8,2,0,0)
67−-- It turns out that these equalities only hold with ghc-8.2 or newer,
68−-- probably due to improvements to CSE
6963inspect $ 'fieldALensManual === 'fieldALensName
7064inspect $ 'fieldALensManual === 'fieldALensType
7165inspect $ 'fieldALensManual === 'fieldALensPos
7266inspect $ 'subtypeLensManual === 'subtypeLensGeneric
73−#endif