diff options
| author | Alec Theriault <alec.theriault@gmail.com> | 2018-08-28 15:14:51 -0700 |
|---|---|---|
| committer | Alec Theriault <alec.theriault@gmail.com> | 2018-11-05 15:54:22 -0800 |
| commit | 91c09e4bda60f89ff477aacf2f214da40a047065 (patch) | |
| tree | d37f31a8c9695c6d4467efe20d6902dc0b36ea54 /haddock-api/src/Haddock/Interface | |
| parent | dd3ff9fff25f20a94cbf8576d38ee3538f5cf797 (diff) | |
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'
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Specialize.hs | 8 |
1 files changed, 4 insertions, 4 deletions
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 |