Specializations

Cabal-syntax/src/Distribution/FieldGrammar/Newtypes.hs

@@ -57,6 +57,7 @@ import Distribution.Compiler (CompilerFlavor)
 import Distribution.License (License)
 import Distribution.Parsec
 import Distribution.Pretty
+import Distribution.Types.Dependency
 import Distribution.Utils.Path
 import Distribution.Version
   ( LowerBound (..)
@@ -101,6 +102,16 @@ class Sep sep where
 
 instance Sep CommaVCat where
   prettySep _ = vcat . punctuate comma
+  {-# SPECIALIZE
+        parseSep
+          :: Proxy CommaVCat
+          -> ParsecParser Dependency
+          -> ParsecParser [Dependency]
+    #-}
+  -- Without this, inlining will beat specialization to the punch and we'll end
+  -- up with an overloaded worker for which the specialization rewrite rule will
+  -- not fire, even with -flate-specialise
+  {-# INLINE[2] parseSep #-}
   parseSep _ p = do
     v <- askCabalSpecVersion
     if v >= CabalSpecV2_2 then parsecLeadingCommaList p else parsecCommaList p

Cabal-syntax/src/Distribution/FieldGrammar/Parsec.hs

@@ -66,6 +66,7 @@ module Distribution.FieldGrammar.Parsec
   , fieldLinesToStream
   ) where
 
+import Distribution.Compat.Lens (ALens')
 import Distribution.Compat.Newtype
 import Distribution.Compat.Prelude
 import Distribution.Utils.Generic (fromUTF8BS)
@@ -82,11 +83,14 @@ import qualified Text.Parsec.Error as P
 
 import Distribution.CabalSpecVersion
 import Distribution.FieldGrammar.Class
+import Distribution.FieldGrammar.Newtypes
 import Distribution.Fields.Field
 import Distribution.Fields.ParseResult
 import Distribution.Parsec
 import Distribution.Parsec.FieldLineStream
 import Distribution.Parsec.Position (positionCol, positionRow)
+import Distribution.Types.Dependency
+import Distribution.Types.SetupBuildInfo
 
 -------------------------------------------------------------------------------
 -- Auxiliary types
@@ -257,6 +261,18 @@ instance FieldGrammar Parsec ParsecFieldGrammar where
           | v >= CabalSpecV3_0 -> pure (ShortText.toShortText $ fieldlinesToFreeText3 pos fls)
           | otherwise -> pure (ShortText.toShortText $ fieldlinesToFreeText fls)
 
+  {-# SPECIALIZE
+        monoidalFieldAla
+          :: FieldName
+          -> ([Dependency] -> List CommaVCat (Identity Dependency) Dependency)
+          -> ALens' SetupBuildInfo [Dependency]
+          -> ParsecFieldGrammar SetupBuildInfo [Dependency]
+    #-}
+
+  -- Without this, inlining will beat specialization to the punch and we'll end
+  -- up with an overloaded worker for which the specialization rewrite rule will
+  -- not fire, even with -flate-specialise
+  {-# INLINE[2] monoidalFieldAla #-}
   monoidalFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser
     where
       parser v fields = case Map.lookup fn fields of

Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs

@@ -157,6 +157,8 @@ packageDescriptionFieldGrammar =
         <$> monoidalFieldAla "license-file" CompatLicenseFile L.licenseFiles
         <*> monoidalFieldAla "license-files" (alaList' FSep RelativePathNT) L.licenseFiles
           ^^^ hiddenField
+{-# SPECIALIZE packageDescriptionFieldGrammar :: ParsecFieldGrammar' PackageDescription #-}
+{-# SPECIALIZE packageDescriptionFieldGrammar :: PrettyFieldGrammar' PackageDescription #-}
 
 -------------------------------------------------------------------------------
 -- Library
@@ -907,3 +909,16 @@ _syntaxExtensions =
           | e <- [minBound .. maxBound]
           , e `notElem` [Safe, Unsafe, Trustworthy]
           ]
+
+-- This is tricky. We end up with overloaded calls to 'parsecCommaList' in this
+-- module, particularly at types 'ParsecParser' and 'Identity Dependency' which
+-- we care to specialize. We can't specialize at the definition site of this
+-- function due to module cycles, so we specialize here. To do so, we have to
+-- mark 'parsecCommaList' inlinable, which you'd think would cause the
+-- specialization (for all specializable calls here) to happen, but they don't.
+-- We need this specialize pragma to make it happen, but GHC warns that it is an
+-- orphan rule.
+{-# SPECIALIZE
+      parsecCommaList
+        :: ParsecParser (Identity Dependency) -> ParsecParser [Identity Dependency]
+  #-}

Cabal-syntax/src/Distribution/Parsec.hs

@@ -298,6 +298,7 @@ parsecStandard f = do
 -- each component must contain an alphabetic character, to avoid
 -- ambiguity in identifiers like foo-1 (the 1 is the version number).
 
+{-# INLINABLE parsecCommaList #-}
 parsecCommaList :: CabalParsing m => m a -> m [a]
 parsecCommaList p = P.sepBy (p <* P.spaces) (P.char ',' *> P.spaces P.<?> "comma")
 
@@ -377,6 +378,7 @@ parsecQuoted = P.between (P.char '"') (P.char '"')
 parsecMaybeQuoted :: CabalParsing m => m a -> m a
 parsecMaybeQuoted p = parsecQuoted p <|> p
 
+{-# SPECIALIZE parsecUnqualComponentName :: ParsecParser String #-}
 parsecUnqualComponentName :: forall m. CabalParsing m => m String
 parsecUnqualComponentName = state0 DList.empty
   where

Cabal-syntax/src/Distribution/Types/Dependency.hs

@@ -139,6 +139,7 @@ instance Pretty Dependency where
 -- >>> map (`simpleParsec'` "mylib:sub") [CabalSpecV2_4, CabalSpecV3_0] :: [Maybe Dependency]
 -- [Nothing,Just (Dependency (PackageName "mylib") (OrLaterVersion (mkVersion [0])) (fromNonEmpty (LSubLibName (UnqualComponentName "sub") :| [])))]
 instance Parsec Dependency where
+  {-# SPECIALIZE parsec :: ParsecParser Dependency #-}
   parsec = do
     name <- parsec
 

Cabal-syntax/src/Distribution/Types/PackageName.hs

@@ -70,6 +70,7 @@ instance Pretty PackageName where
   pretty = Disp.text . unPackageName
 
 instance Parsec PackageName where
+  {-# SPECIALIZE parsec :: ParsecParser PackageName #-}
   parsec = mkPackageName <$> parsecUnqualComponentName
 
 instance NFData PackageName where

Cabal-syntax/src/Distribution/Types/Version.hs

@@ -99,6 +99,7 @@ instance Pretty Version where
       )
 
 instance Parsec Version where
+  {-# SPECIALIZE parsec :: ParsecParser Version #-}
   parsec = mkVersion <$> toList <$> P.sepByNonEmpty versionDigitParser (P.char '.') <* tags
     where
       tags = do
@@ -110,6 +111,7 @@ instance Parsec Version where
 -- | An integral without leading zeroes.
 --
 -- @since 3.0
+{-# SPECIALIZE versionDigitParser :: ParsecParser Int #-}
 versionDigitParser :: CabalParsing m => m Int
 versionDigitParser = (some d >>= toNumber) P.<?> "version digit (integral without leading zeroes)"
   where

Cabal-syntax/src/Distribution/Types/VersionRange/Internal.hs

@@ -332,6 +332,7 @@ prettyVersionRange16 vr = prettyVersionRange vr
 -- >>> map (`simpleParsecW'` "== 1.2.*") [CabalSpecV1_4, CabalSpecV1_6] :: [Maybe VersionRange]
 -- [Nothing,Just (IntersectVersionRanges (OrLaterVersion (mkVersion [1,2])) (EarlierVersion (mkVersion [1,3])))]
 instance Parsec VersionRange where
+  {-# SPECIALIZE parsec :: ParsecParser VersionRange #-}
   parsec = askCabalSpecVersion >>= versionRangeParser versionDigitParser
 
 -- | 'VersionRange' parser parametrised by version digit parser.
@@ -341,6 +342,12 @@ instance Parsec VersionRange where
 --   versions, 'PkgConfigVersionRange'.
 --
 -- @since 3.0
+{-# SPECIALIZE
+      versionRangeParser
+        :: ParsecParser Int
+        -> CabalSpecVersion
+        -> ParsecParser VersionRange
+  #-}
 versionRangeParser :: forall m. CabalParsing m => m Int -> CabalSpecVersion -> m VersionRange
 versionRangeParser digitParser csv = expr
   where