From 91c09e4bda60f89ff477aacf2f214da40a047065 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Tue, 28 Aug 2018 15:14:51 -0700 Subject: Specialize some SYB functions Perf only change: * Add a 'SPECIALIZE' pragma to help GHC optimize a 'Data a =>' constraint * Manually specialize the needlessly general type of 'specializeTyVarBndrs' --- haddock-api/src/Haddock/Interface/Specialize.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'haddock-api') diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index 30931c26..e9511e3d 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -47,14 +47,13 @@ specialize specs = go spec_map0 -- one by one, we should avoid infinite loops. spec_map0 = foldr (\(n,t) acc -> Map.insert n (go acc t) acc) mempty specs +{-# SPECIALIZE specialize :: [(Name, HsType GhcRn)] -> HsType GhcRn -> HsType GhcRn #-} -- | Instantiate given binders with corresponding types. -- -- Again, it is just a convenience function around 'specialize'. Note that -- length of type list should be the same as the number of binders. -specializeTyVarBndrs :: Data a - => LHsQTyVars GhcRn -> [HsType GhcRn] - -> a -> a +specializeTyVarBndrs :: LHsQTyVars GhcRn -> [HsType GhcRn] -> HsType GhcRn -> HsType GhcRn specializeTyVarBndrs bndrs typs = specialize $ zip bndrs' typs where @@ -64,11 +63,12 @@ specializeTyVarBndrs bndrs typs = bname (XTyVarBndr _) = error "haddock:specializeTyVarBndrs" + specializePseudoFamilyDecl :: LHsQTyVars GhcRn -> [HsType GhcRn] -> PseudoFamilyDecl GhcRn -> PseudoFamilyDecl GhcRn specializePseudoFamilyDecl bndrs typs decl = - decl {pfdTyVars = map (specializeTyVarBndrs bndrs typs) (pfdTyVars decl)} + decl {pfdTyVars = map (fmap (specializeTyVarBndrs bndrs typs)) (pfdTyVars decl)} specializeSig :: LHsQTyVars GhcRn -> [HsType GhcRn] -> Sig GhcRn -- cgit v1.2.3