[Git][ghc/ghc][wip/T24359] Specialise expressions: polishing

sheaf (@sheaf) gitlab at gitlab.haskell.org
Tue Dec 3 00:43:11 UTC 2024



sheaf pushed to branch wip/T24359 at Glasgow Haskell Compiler / GHC


Commits:
ea70f1d9 by sheaf at 2024-12-02T12:48:06+01:00
Specialise expressions: polishing

This commit:

  - adds flags -Wdeprecated-pragmas and -Wuseless-specialisations,
  - uses -Wdeprecated-pragmas to control the warning when using old-style
    SPECIALISE pragmas with multiple type ascriptions,
  - uses -Wuseless-specialisations to control the warning emitted when
    GHC determines that a SPECIALISE pragma would have no effect,
  - makes GHC continue to generate seemingly useless SPECIALISE pragmas,
    as per user request (see new test T25389),
  - adds deprecations to Template Haskell `pragSpecD` and `pracSpecInlD`,
  - adds mention of the changes to the 9.14 release notes as well as
    the Template Haskell changelog,

- - - - -


28 changed files:

- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Errors/Ppr.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/Language/Haskell/Syntax/Binds.hs
- docs/users_guide/9.14.1-notes.rst
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/template-haskell/changelog.md
- + testsuite/tests/simplCore/should_compile/T25389.hs
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/typecheck/should_compile/SpecPragmas.hs
- + testsuite/tests/typecheck/should_fail/SpecPragmasFail.hs
- + testsuite/tests/typecheck/should_fail/SpecPragmasFail.stderr
- + testsuite/tests/warnings/should_compile/SpecMultipleTys.hs
- + testsuite/tests/warnings/should_compile/SpecMultipleTys.stderr
- testsuite/tests/warnings/should_compile/all.T
- + testsuite/tests/warnings/should_fail/SpecEMultipleTys.hs
- + testsuite/tests/warnings/should_fail/SpecEMultipleTys.stderr
- testsuite/tests/warnings/should_fail/all.T


Changes:

=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -1071,6 +1071,8 @@ data WarningFlag =
    | Opt_WarnDeprecatedTypeAbstractions              -- Since 9.10
    | Opt_WarnDefaultedExceptionContext               -- Since 9.10
    | Opt_WarnViewPatternSignatures                   -- Since 9.12
+   | Opt_WarnUselessSpecialisations                  -- Since 9.14
+   | Opt_WarnDeprecatedPragmas                       -- Since 9.14
    deriving (Eq, Ord, Show, Enum, Bounded)
 
 -- | Return the names of a WarningFlag
@@ -1188,6 +1190,8 @@ warnFlagNames wflag = case wflag of
   Opt_WarnDeprecatedTypeAbstractions              -> "deprecated-type-abstractions" :| []
   Opt_WarnDefaultedExceptionContext               -> "defaulted-exception-context" :| []
   Opt_WarnViewPatternSignatures                   -> "view-pattern-signatures" :| []
+  Opt_WarnUselessSpecialisations                  -> "useless-specialisations" :| ["useless-specializations"]
+  Opt_WarnDeprecatedPragmas                       -> "deprecated-pragmas" :| []
 
 -- -----------------------------------------------------------------------------
 -- Standard sets of warning options
@@ -1329,7 +1333,9 @@ standardWarnings -- see Note [Documenting warning flags]
         Opt_WarnInconsistentFlags,
         Opt_WarnDataKindsTC,
         Opt_WarnTypeEqualityOutOfScope,
-        Opt_WarnViewPatternSignatures
+        Opt_WarnViewPatternSignatures,
+        Opt_WarnUselessSpecialisations,
+        Opt_WarnDeprecatedPragmas
       ]
 
 -- | Things you get with -W


=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2360,6 +2360,8 @@ wWarningFlagsDeps = [minBound..maxBound] >>= \x -> case x of
   Opt_WarnDeprecatedTypeAbstractions -> warnSpec x
   Opt_WarnDefaultedExceptionContext -> warnSpec x
   Opt_WarnViewPatternSignatures -> warnSpec x
+  Opt_WarnUselessSpecialisations -> warnSpec x
+  Opt_WarnDeprecatedPragmas -> warnSpec x
 
 warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)]
 warningGroupsDeps = map mk warningGroups


=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -1,5 +1,6 @@
 
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE TypeFamilies #-}
 
 {-
@@ -85,6 +86,7 @@ import GHC.Utils.Panic
 
 import Control.Monad
 
+
 {-**********************************************************************
 *                                                                      *
            Desugaring a MonoBinds
@@ -974,29 +976,22 @@ finishSpecPrag :: Name -> CoreExpr                    -- RHS to specialise
                -> DsM (Maybe (OrdList (Id,CoreExpr), CoreRule))
 finishSpecPrag poly_nm poly_rhs rule_bndrs poly_id rule_args
                                 spec_bndrs mk_spec_body spec_inl
-  | isJust (isClassOpId_maybe poly_id)
-  = do { diagnosticDs (DsUselessSpecialiseForClassMethodSelector poly_nm)
-       ; return Nothing  }  -- There is no point in trying to specialise a class op
-                            -- Moreover, classops don't (currently) have an inl_sat arity set
-                            -- (it would be Just 0) and that in turn makes makeCorePair bleat
-
-  | no_act_spec && isNeverActive rule_act
-  = do { diagnosticDs (DsUselessSpecialiseForNoInlineFunction poly_nm)
-       ; return Nothing  }  -- Function is NOINLINE, and the specialisation inherits that
-                            -- See Note [Activation pragmas for SPECIALISE]
-
-  | all is_nop_arg rule_args
-  = do { diagnosticDs (DsUselessSpecialise poly_nm)
-       ; return Nothing  }  -- Specialisation does nothing
-
-  | otherwise
-  -- The RULE looks like
-  --    RULE "USPEC" forall rule_bndrs. f rule_args = $sf spec_bndrs
-  -- The specialised function looks like
-  --    $sf spec_bndrs = mk_spec_body <f's original rhs>
-  -- We also use mk_spec_body to specialise the methods in f's stable unfolding
-  -- NB: spec_bindrs is a subset of rule_bndrs
-  = do { this_mod <- getModule
+  = do { want_spec <-
+            case mb_useless of
+              Just useless ->
+                 do { diagnosticDs $ DsUselessSpecialisePragma poly_nm useless
+                    ; return $ uselessSpecialisePragmaKeepAnyway useless }
+              Nothing -> return True
+       ; if not want_spec
+         then return Nothing
+         else Just <$>
+    -- The RULE looks like
+    --    RULE "USPEC" forall rule_bndrs. f rule_args = $sf spec_bndrs
+    -- The specialised function looks like
+    --    $sf spec_bndrs = mk_spec_body <f's original rhs>
+    -- We also use mk_spec_body to specialise the methods in f's stable unfolding
+    -- NB: spec_bindrs is a subset of rule_bndrs
+    do { this_mod <- getModule
        ; uniq     <- newUnique
        ; dflags   <- getDynFlags
        ; let poly_name  = idName poly_id
@@ -1025,12 +1020,29 @@ finishSpecPrag poly_nm poly_rhs rule_bndrs poly_id rule_args
             [ text "fun:" <+> ppr poly_id
             , text "spec_bndrs:" <+>  ppr spec_bndrs
             , text "args:" <+>  ppr rule_args ])
-       ; return (Just (unitOL (spec_id, spec_rhs), rule))
+       ; return (unitOL (spec_id, spec_rhs), rule)
             -- NB: do *not* use makeCorePair on (spec_id,spec_rhs), because
             --     makeCorePair overwrites the unfolding, which we have
             --     just created using specUnfolding
-       }
+       } }
   where
+    -- Is this SPECIALISE pragma useless?
+    mb_useless =
+      if | isJust (isClassOpId_maybe poly_id)
+         -- There is no point in trying to specialise a class op
+         -- Moreover, classops don't (currently) have an inl_sat arity set
+         -- (it would be Just 0) and that in turn makes makeCorePair bleat
+         -> Just UselessSpecialiseForClassMethodSelector
+         | no_act_spec && isNeverActive rule_act
+         -- Function is NOINLINE, and the specialisation inherits that
+         -- See Note [Activation pragmas for SPECIALISE]
+         -> Just UselessSpecialiseForNoInlineFunction
+         | all is_nop_arg rule_args
+         -- The specialisation does nothing.
+         -> Just UselessSpecialiseNoSpecialisation
+         | otherwise
+         -> Nothing
+
     -- See Note [Activation pragmas for SPECIALISE]
     -- no_act_spec is True if the user didn't write an explicit
     -- phase specification in the SPECIALISE pragma


=====================================
compiler/GHC/HsToCore/Errors/Ppr.hs
=====================================
@@ -83,15 +83,22 @@ instance Diagnostic DsMessage where
                StrictBinds       -> "strict bindings"
          in mkSimpleDecorated $
               hang (text "Top-level" <+> text desc <+> text "aren't allowed:") 2 (ppr bind)
-    DsUselessSpecialiseForClassMethodSelector poly_id
-      -> mkSimpleDecorated $
-           text "Ignoring useless SPECIALISE pragma for class selector:" <+> quotes (ppr poly_id)
-    DsUselessSpecialiseForNoInlineFunction poly_id
-      -> mkSimpleDecorated $
-          text "Ignoring useless SPECIALISE pragma for NOINLINE function:" <+> quotes (ppr poly_id)
-    DsUselessSpecialise poly_id
-      -> mkSimpleDecorated $
-          text "Ignoring useless SPECIALISE pragma for:" <+> quotes (ppr poly_id)
+    DsUselessSpecialisePragma poly_id rea ->
+      mkSimpleDecorated $
+        what <+> text "SPECIALISE pragma for" <> why
+      where
+        quoted_id = quotes (ppr poly_id)
+        what =
+          if uselessSpecialisePragmaKeepAnyway rea
+          then text "Seemingly useless"
+          else text "Ignoring useless"
+        why = case rea of
+          UselessSpecialiseForClassMethodSelector ->
+            text " class selector:" <+> quoted_id
+          UselessSpecialiseForNoInlineFunction ->
+            text " NOINLINE function:" <+> quoted_id
+          UselessSpecialiseNoSpecialisation ->
+            colon <+> quoted_id
     DsOrphanRule rule
       -> mkSimpleDecorated $ text "Orphan rule:" <+> ppr rule
     DsRuleLhsTooComplicated orig_lhs lhs2
@@ -227,9 +234,7 @@ instance Diagnostic DsMessage where
     DsNonExhaustivePatterns _ (ExhaustivityCheckType mb_flag) _ _ _
       -> maybe WarningWithoutFlag WarningWithFlag mb_flag
     DsTopLevelBindsNotAllowed{}                 -> ErrorWithoutFlag
-    DsUselessSpecialiseForClassMethodSelector{} -> WarningWithoutFlag
-    DsUselessSpecialiseForNoInlineFunction{}    -> WarningWithoutFlag
-    DsUselessSpecialise{}                       -> WarningWithoutFlag
+    DsUselessSpecialisePragma{}                 -> WarningWithFlag Opt_WarnUselessSpecialisations
     DsOrphanRule{}                              -> WarningWithFlag Opt_WarnOrphans
     DsRuleLhsTooComplicated{}                   -> WarningWithoutFlag
     DsRuleIgnoredDueToConstructor{}             -> WarningWithoutFlag
@@ -264,9 +269,7 @@ instance Diagnostic DsMessage where
     DsMaxPmCheckModelsReached{}                 -> [SuggestIncreaseMaxPmCheckModels]
     DsNonExhaustivePatterns{}                   -> noHints
     DsTopLevelBindsNotAllowed{}                 -> noHints
-    DsUselessSpecialiseForClassMethodSelector{} -> noHints
-    DsUselessSpecialiseForNoInlineFunction{}    -> noHints
-    DsUselessSpecialise{}                       -> noHints
+    DsUselessSpecialisePragma{}                 -> noHints
     DsOrphanRule{}                              -> noHints
     DsRuleLhsTooComplicated{}                   -> noHints
     DsRuleIgnoredDueToConstructor{}             -> noHints


=====================================
compiler/GHC/HsToCore/Errors/Types.hs
=====================================
@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module GHC.HsToCore.Errors.Types where
@@ -105,11 +106,17 @@ data DsMessage
 
   | DsTopLevelBindsNotAllowed !BindsType !(HsBindLR GhcTc GhcTc)
 
-  | DsUselessSpecialiseForClassMethodSelector !Name
+    {-| DsUselessSpecialisePragma is a warning (controlled by the -Wuseless-specialisations flag)
+        that is emitted for SPECIALISE pragmas that don't do anything.
 
-  | DsUselessSpecialiseForNoInlineFunction !Name
+        Examples:
 
-  | DsUselessSpecialise !Name
+          foo :: forall a. a -> a
+          {-# SPECIALISE foo :: Int -> Int #-}
+    -}
+  | DsUselessSpecialisePragma
+      !Name
+      !UselessSpecialisePragmaReason
 
   | DsOrphanRule !CoreRule
 
@@ -197,6 +204,26 @@ data ThRejectionReason
   | ThSplicesWithinDeclBrackets
   | ThNonLinearDataCon
 
+-- | Why is a @SPECIALISE@ pragmas useless?
+data UselessSpecialisePragmaReason
+  -- | Useless @SPECIALISE@ pragma for a class method
+  = UselessSpecialiseForClassMethodSelector
+  -- | Useless @SPECIALISE@ pragma for a function with NOINLINE
+  | UselessSpecialiseForNoInlineFunction
+  -- | Useless @SPECIALISE@ pragma which generates a specialised function
+  -- which is identical to the original function at runtime.
+  | UselessSpecialiseNoSpecialisation
+  deriving Generic
+
+uselessSpecialisePragmaKeepAnyway :: UselessSpecialisePragmaReason -> Bool
+uselessSpecialisePragmaKeepAnyway = \case
+  UselessSpecialiseForClassMethodSelector -> False
+  UselessSpecialiseForNoInlineFunction -> False
+  UselessSpecialiseNoSpecialisation -> True
+    -- See #25389/T25389 for why we might want to keep this specialisation
+    -- around even if it seemingly does nothing.
+
+
 data NegLiteralExtEnabled
   = YesUsingNegLiterals
   | NotUsingNegLiterals


=====================================
compiler/GHC/Parser/Errors/Ppr.hs
=====================================
@@ -573,7 +573,11 @@ instance Diagnostic PsMessage where
 
     PsErrSpecExprMultipleTypeAscription
       -> mkSimpleDecorated $
-        text "SPECIALIZE expression doesn't support multiple specialize type ascriptions"
+           text "SPECIALISE expression doesn't support multiple type ascriptions"
+
+    PsWarnSpecMultipleTypeAscription
+      -> mkSimpleDecorated $
+           text "SPECIALISE pragmas with multiple type ascriptions are deprecated, and will be removed in GHC 9.18"
 
   diagnosticReason  = \case
     PsUnknownMessage m                            -> diagnosticReason m
@@ -694,6 +698,7 @@ instance Diagnostic PsMessage where
     PsErrIllegalOrPat{}                           -> ErrorWithoutFlag
     PsErrTypeSyntaxInPat{}                        -> ErrorWithoutFlag
     PsErrSpecExprMultipleTypeAscription{}         -> ErrorWithoutFlag
+    PsWarnSpecMultipleTypeAscription{}            -> WarningWithFlag Opt_WarnDeprecatedPragmas
 
   diagnosticHints = \case
     PsUnknownMessage m                            -> diagnosticHints m
@@ -863,7 +868,8 @@ instance Diagnostic PsMessage where
     PsErrInvalidPun {}                            -> [suggestExtension LangExt.ListTuplePuns]
     PsErrIllegalOrPat{}                           -> [suggestExtension LangExt.OrPatterns]
     PsErrTypeSyntaxInPat{}                        -> noHints
-    PsErrSpecExprMultipleTypeAscription {}        -> noHints
+    PsErrSpecExprMultipleTypeAscription {}        -> [SuggestSplittingIntoSeveralSpecialisePragmas]
+    PsWarnSpecMultipleTypeAscription{}            -> [SuggestSplittingIntoSeveralSpecialisePragmas]
 
   diagnosticCode = constructorCode
 


=====================================
compiler/GHC/Parser/Errors/Types.hs
=====================================
@@ -491,8 +491,22 @@ data PsMessage
    --               T24159_pat_parse_error_6
    | PsErrTypeSyntaxInPat !PsErrTypeSyntaxDetails
 
+   -- | 'PsErrSpecExprMultipleTypeAscription' is an error that occurs when
+   -- a user attempts to use the new form SPECIALISE pragma syntax with
+   -- multiple type signatures, e.g.
+   --
+   -- @{-# SPECIALISE foo 3 :: Float -> Float; Double -> Double #-}
    | PsErrSpecExprMultipleTypeAscription
 
+   -- | 'PsWarnSpecMultipleTypeAscription' is a warning that occurs when
+   -- a user uses the old-form SPECIALISE pragma syntax with
+   -- multiple type signatures, e.g.
+   --
+   -- @{-# SPECIALISE bar :: Float -> Float; Double -> Double #-}
+   --
+   -- This constructor is deprecated and will be removed in GHC 9.18.
+   | PsWarnSpecMultipleTypeAscription
+
    deriving Generic
 
 -- | Extra details about a parse error, which helps


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1069,19 +1069,18 @@ mkSpecSig inl_prag activation_anns m_rule_binds expr m_sigtypes_ascr
         -- Use the old SpecSig route
         | Nothing <- m_rule_binds
         , L _ (HsVar _ var) <- expr
-        -> pure $
-           SpecSig activation_anns
-                   var sigtype_list inl_prag
+        -> do addPsMessage sigs_loc PsWarnSpecMultipleTypeAscription
+              pure $
+                SpecSig activation_anns var sigtype_list inl_prag
 
-        | otherwise -> ps_err PsErrSpecExprMultipleTypeAscription
+        | otherwise ->
+            addFatalError $
+              mkPlainErrorMsgEnvelope sigs_loc PsErrSpecExprMultipleTypeAscription
 
         where
           sigtype_list = fromOL sigtype_ol
-
-  where
-    ps_err = addFatalError
-           . mkPlainErrorMsgEnvelope
-              (getHasLoc (ass_open activation_anns) `combineSrcSpans` getHasLoc (ass_close activation_anns))
+          sigs_loc =
+            getHasLoc colon_ann `combineSrcSpans` getHasLoc (last sigtype_list)
 
 checkRecordSyntax :: (MonadP m, Outputable a) => LocatedA a -> m (LocatedA a)
 checkRecordSyntax lr@(L loc r)


=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -2593,6 +2593,7 @@ data TcRnMessage where
                 typecheck/should_compile/T10504
   -}
   TcRnNonOverloadedSpecialisePragma :: !(LIdP GhcRn) -> TcRnMessage
+    -- NB: this constructor is deprecated and will be removed in GHC 9.18 (#25540)
 
   {-| TcRnSpecialiseNotVisible is a warning that occurs when the subject of a
      SPECIALISE pragma has a definition that is not visible from the current module.


=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -28,7 +28,7 @@ import GHC.Core.InstEnv (LookupInstanceErrReason)
 import GHC.Iface.Errors.Types
 import GHC.Driver.Errors.Types   ( DriverMessage, GhcMessageOpts, DriverMessageOpts )
 import GHC.Parser.Errors.Types   ( PsMessage, PsHeaderMessage )
-import GHC.HsToCore.Errors.Types ( DsMessage )
+import GHC.HsToCore.Errors.Types ( DsMessage, UselessSpecialisePragmaReason )
 import GHC.Tc.Errors.Types
 import GHC.Unit.Module.Warnings ( WarningTxt )
 import GHC.Utils.Panic.Plain
@@ -147,9 +147,6 @@ type family GhcDiagnosticCode c = n | n -> c where
   GhcDiagnosticCode "DsMaxPmCheckModelsReached"                     = 61505
   GhcDiagnosticCode "DsNonExhaustivePatterns"                       = 62161
   GhcDiagnosticCode "DsTopLevelBindsNotAllowed"                     = 48099
-  GhcDiagnosticCode "DsUselessSpecialiseForClassMethodSelector"     = 93315
-  GhcDiagnosticCode "DsUselessSpecialiseForNoInlineFunction"        = 38524
-  GhcDiagnosticCode "DsUselessSpecialise"                           = 66582
   GhcDiagnosticCode "DsOrphanRule"                                  = 58181
   GhcDiagnosticCode "DsRuleLhsTooComplicated"                       = 69441
   GhcDiagnosticCode "DsRuleIgnoredDueToConstructor"                 = 00828
@@ -166,6 +163,10 @@ type family GhcDiagnosticCode c = n | n -> c where
   GhcDiagnosticCode "DsAnotherRuleMightFireFirst"                   = 87502
   GhcDiagnosticCode "DsIncompleteRecordSelector"                    = 17335
 
+    -- Constructors of 'UselessSpecialisePragmaReason'
+  GhcDiagnosticCode "UselessSpecialiseForClassMethodSelector"       = 93315
+  GhcDiagnosticCode "UselessSpecialiseForNoInlineFunction"          = 38524
+  GhcDiagnosticCode "UselessSpecialiseNoSpecialisation"             = 66582
 
   -- Parser diagnostic codes
   GhcDiagnosticCode "PsErrParseLanguagePragma"                      = 68686
@@ -292,6 +293,7 @@ type family GhcDiagnosticCode c = n | n -> c where
   GhcDiagnosticCode "PsErrIllegalOrPat"                             = 29847
   GhcDiagnosticCode "PsErrTypeSyntaxInPat"                          = 32181
   GhcDiagnosticCode "PsErrSpecExprMultipleTypeAscription"           = 62037
+  GhcDiagnosticCode "PsWarnSpecMultipleTypeAscription"              = 73026
 
   -- Driver diagnostic codes
   GhcDiagnosticCode "DriverMissingHomeModules"                      = 32850
@@ -907,7 +909,11 @@ type family GhcDiagnosticCode c = n | n -> c where
   -- NB: never remove a return value from this type family!
   -- We need to ensure uniquess of diagnostic codes across GHC versions,
   -- and this includes outdated diagnostic codes for errors that GHC
-  -- no longer reports. These are collected below.
+  -- no longer reports.
+  --
+  -- We used to collect all the outdated diagnostic codes below, but this
+  -- turned out to be a source of merge conflicts, so we no longer move
+  -- a diagnostic below when marking it outdated.
 
   GhcDiagnosticCode "TcRnIllegalInstanceHeadDecl"                   = Outdated 12222
   GhcDiagnosticCode "TcRnNoClassInstHead"                           = Outdated 56538
@@ -982,6 +988,11 @@ type family ConRecursInto con where
   ConRecursInto "PsUnknownMessage"         = 'Just (UnknownDiagnostic NoDiagnosticOpts)
   ConRecursInto "PsHeaderMessage"          = 'Just PsHeaderMessage
 
+  ----------------------------------
+  -- Constructors of DsMessage
+
+  ConRecursInto "DsUselessSpecialisePragma" = 'Just UselessSpecialisePragmaReason
+
   ----------------------------------
   -- Constructors of TcRnMessage
 


=====================================
compiler/GHC/Types/Hint.hs
=====================================
@@ -504,6 +504,11 @@ data GhcHint
   {-| Suggest add parens to pattern `e -> p :: t` -}
   | SuggestParenthesizePatternRHS
 
+  {-| Suggest splitting up a SPECIALISE pragmas with multiple type ascriptions
+      into several individual SPECIALISE pragmas.
+  -}
+  | SuggestSplittingIntoSeveralSpecialisePragmas
+
 -- | The deriving strategy that was assumed when not explicitly listed in the
 --   source. This is used solely by the missing-deriving-strategies warning.
 --   There's no `Via` case because we never assume that.


=====================================
compiler/GHC/Types/Hint/Ppr.hs
=====================================
@@ -288,6 +288,8 @@ instance Outputable GhcHint where
         (hsep [text "deriving", ppr strat, text "instance", ppr deriv_sig])
     SuggestParenthesizePatternRHS
       -> text "Parenthesize the RHS of the view pattern"
+    SuggestSplittingIntoSeveralSpecialisePragmas
+      -> text "Split the SPECIALISE pragma into multiple pragmas, one for each type signature"
 
 perhapsAsPat :: SDoc
 perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"


=====================================
compiler/Language/Haskell/Syntax/Binds.hs
=====================================
@@ -359,6 +359,8 @@ data Sig pass
         -- | An old-form specialisation pragma
         --
         -- > {-# SPECIALISE f :: Int -> Int #-}
+        --
+        -- NB: this constructor is deprecated and will be removed in GHC 9.18 (#25540)
   | SpecSig     (XSpecSig pass)
                 (LIdP pass)        -- Specialise a function or datatype  ...
                 [LHsSigType pass]  -- ... to these types


=====================================
docs/users_guide/9.14.1-notes.rst
=====================================
@@ -11,8 +11,25 @@ for specific guidance on migrating programs to this release.
 Language
 ~~~~~~~~
 
+* `GHC proposal 493: allow expressions in SPECIALISE pragmas <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0493-specialise-expressions.rst>`_
+  has been implemented. SPECIALISE pragmas now allow arbitrary expressions such as: ::
+
+    {-# SPECIALISE f @Int False :: Int -> Char #-}
+
+  The ability to specify multiple specialisations in a single SPECIALISE pragma,
+  with syntax of the form (note the comma between the type signatures): ::
+
+    {-# SPECIALISE g : Int -> Int, Float -> Float #-}
+
+  has been deprecated, and is scheduled to be removed in GHC 9.18.
+  This deprecation is controlled by the newly introduced ``-Wdeprecated-pragmas``
+  flag in ``-Wdefault``.
+
+* A new flag, `-Wuseless-specialisations`, controls warnings emitted when GHC
+  determines that a SPECIALISE pragma would have no effect.
+
 * ``-Wincomplete-record-selectors`` is now part of `-Wall`, as specified
-  by `GHC Proposal 516: add warning for incomplete record selectors <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0516-incomplete-record-selectors.rst>_`.
+  by `GHC Proposal 516: add warning for incomplete record selectors <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0516-incomplete-record-selectors.rst>`_.
   Hence, if a library is compiled with ``-Werror``, compilation may now fail. Solution: fix the library.
   Workaround: add ``-Werror=no-incomplete-record-selectors``.
 
@@ -47,6 +64,11 @@ Cmm
 ``ghc`` library
 ~~~~~~~~~~~~~~~
 
+* As part of the implementation of `GHC proposal 493 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0493-specialise-expressions.rst>`_,
+  the `SpecSig` constructor of `Sig` has been deprecated. It is replaced by
+  the constructor `SpecSigE` which supports expressions at the head, rather than
+  a lone variable.
+
 ``ghc-heap`` library
 ~~~~~~~~~~~~~~~~~~~~
 
@@ -71,6 +93,13 @@ Cmm
 ``template-haskell`` library
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
+- As part of the implementation of `GHC proposal 493 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0493-specialise-expressions.rst>`_,
+  the ``SpecialiseP`` constructor of the Template Haskell ``Pragma`` type, as
+  well as the helpers ``pragSpecD`` and ``pragSpecInlD``, have been deprecated.
+
+  They are replaced, respectively, by ``SpecialiseEP``, ``pragSpecED`` and
+  ``pragSpecInlED``.
+
 Included libraries
 ~~~~~~~~~~~~~~~~~~
 


=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
=====================================
@@ -553,12 +553,14 @@ pragInlD name inline rm phases
 pragOpaqueD :: Quote m => Name -> m Dec
 pragOpaqueD name = pure $ PragmaD $ OpaqueP name
 
+{-# DEPRECATED pragSpecD "Please use 'pragSpecED' instead. 'pragSpecD' will be removed in GHC 9.18." #-}
 pragSpecD :: Quote m => Name -> m Type -> Phases -> m Dec
 pragSpecD n ty phases
   = do
       ty1    <- ty
       pure $ PragmaD $ SpecialiseP n ty1 Nothing phases
 
+{-# DEPRECATED pragSpecInlD "Please use 'pragSpecInlED' instead. 'pragSpecInlD' will be removed in GHC 9.18." #-}
 pragSpecInlD :: Quote m => Name -> m Type -> Inline -> Phases -> m Dec
 pragSpecInlD n ty inline phases
   = do


=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
=====================================
@@ -2165,6 +2165,8 @@ data Pragma = InlineP         Name Inline RuleMatch Phases
             -- ^ @{ {\-\# OPAQUE T #-} }@
             | SpecialiseP     Name Type (Maybe Inline) Phases
             -- ^ @{ {\-\# SPECIALISE [INLINE] [phases] nm :: ty #-} }@
+            --
+            -- NB: this constructor is deprecated and will be removed in GHC 9.18
             | SpecialiseEP    (Maybe [TyVarBndr ()]) [RuleBndr] Exp (Maybe Inline) Phases
             -- ^ @{ {\-\# SPECIALISE [INLINE] [phases] exp #-} }@
             | SpecialiseInstP Type


=====================================
libraries/template-haskell/changelog.md
=====================================
@@ -1,5 +1,14 @@
 # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell)
 
+## 2.24.0.0
+
+  * As part of the implementation of [GHC proposal 493](https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0493-specialise-expressions.rst),
+    the ``SpecialiseP`` constructor of `Pragma`, as well as the helper functions
+    `pragSpecD` and `pragSpecInlD`, have been deprecated.
+
+    They are replaced, respectively, by `SpecialiseEP`, `pragSpecED` and
+    `pragSpecInlED`.
+
 ## 2.23.0.0
 
   * Extend `Exp` with `ForallE`, `ForallVisE`, `ConstraintedE`,


=====================================
testsuite/tests/simplCore/should_compile/T25389.hs
=====================================
@@ -0,0 +1,19 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+
+{-# OPTIONS_GHC -Wno-useless-specialisations #-}
+
+module T25389 where
+
+data Example (b :: Bool) where
+  Ex1 :: Int -> Example True
+  Ex2 :: Example False
+
+expensive :: Int -> Int
+expensive = (*2)
+
+{-# SPECIALISE INLINE op :: Example False -> Int #-}
+op :: Example b -> Int
+op e = case e of
+  Ex1 i -> expensive i
+  Ex2 -> 0


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -532,3 +532,4 @@ test('T24725a', [ grep_errmsg(r'testedRule')], compile, ['-O -ddump-rule-firings
 test('T25033', normal, compile, ['-O'])
 test('T25160', normal, compile, ['-O -ddump-rules'])
 test('T25197', [req_th, extra_files(["T25197_TH.hs"]), only_ways(['optasm'])], multimod_compile, ['T25197', '-O2 -v0'])
+test('T25389', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds'])


=====================================
testsuite/tests/typecheck/should_compile/SpecPragmas.hs
=====================================
@@ -0,0 +1,34 @@
+
+{-# LANGUAGE NamedWildCards, PartialTypeSignatures #-}
+
+module SpecPragmas where
+
+foo :: Num a => a -> a
+foo x = x + 1
+
+{-# SPECIALISE foo @Int #-}
+
+{-# SPECIALISE foo @Float :: Float -> Float #-}
+
+{-# SPECIALISE foo (3 :: Int) #-}
+{-# SPECIALISE foo @Int 4 #-}
+
+
+{-# SPECIALISE INLINE foo @Double #-}
+
+bar :: ( Num a, Integral i ) => a -> i -> a
+bar x y = x + fromIntegral y
+
+{-# SPECIALISE bar @Float :: Float -> Int -> Float #-}
+
+{-# SPECIALISE bar @Double 3 :: Integer -> Double #-}
+
+{-# SPECIALISE [1] bar @_ @Int #-}
+
+{-# SPECIALISE bar @_a @_a #-}
+
+baz :: (Real a, Integral b, Fractional c) => a -> b -> c
+baz a b = realToFrac a + fromIntegral b
+
+{-# SPECIALISE [~1] forall a. forall. baz @a @_ @a #-}
+


=====================================
testsuite/tests/typecheck/should_fail/SpecPragmasFail.hs
=====================================
@@ -0,0 +1,14 @@
+
+module SpecPragmasFail where
+
+foo :: Num a => a -> a
+foo x = x + 1
+
+{-# SPECIALISE foo @Integer :: Int -> Int #-}
+
+{-# SPECIALISE foo @Bool #-}
+
+bar :: a ~ Int => a
+bar = 3
+
+{-# SPECIALISE bar @Char #-}


=====================================
testsuite/tests/typecheck/should_fail/SpecPragmasFail.stderr
=====================================
@@ -0,0 +1,6 @@
+SpecPragmasFail.hs:7:16: error: [GHC-83865]
+    • Couldn't match type ‘Integer’ with ‘Int’
+      Expected: Int -> Int
+        Actual: Integer -> Integer
+    • In the expression: foo @Integer :: Int -> Int
+


=====================================
testsuite/tests/warnings/should_compile/SpecMultipleTys.hs
=====================================
@@ -0,0 +1,12 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+
+module SpecMultipleTys where
+
+-- NB: this program should be rejected starting from GHC 9.18.
+-- See GHC ticket #25540.
+
+foo :: Num a => a -> a
+foo x = 2 * ( x + 1 )
+
+{-# SPECIALISE foo :: Float -> Float, Double -> Double #-}


=====================================
testsuite/tests/warnings/should_compile/SpecMultipleTys.stderr
=====================================
@@ -0,0 +1,5 @@
+SpecMultipleTys.hs:12:20: warning: [GHC-73026] [-Wdeprecated-pragmas (in -Wdefault)]
+    SPECIALISE pragmas with multiple type ascriptions are deprecated, and will be removed in GHC 9.18
+    Suggested fix:
+      Split the SPECIALISE pragma into multiple pragmas, one for each type signature
+


=====================================
testsuite/tests/warnings/should_compile/all.T
=====================================
@@ -71,3 +71,4 @@ test('T23573', [extra_files(["T23573.hs", "T23573A.hs", "T23573B.hs"])], multimo
 test('T23465', normal, compile, ['-ddump-parsed'])
 test('WarnNoncanonical', normal, compile, [''])
 test('T24396', [extra_files(["T24396a.hs", "T24396b.hs"])], multimod_compile, ['T24396b', ''])
+test('SpecMultipleTys', normal, compile, ['']) # compile_fail from GHC 9.18


=====================================
testsuite/tests/warnings/should_fail/SpecEMultipleTys.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+
+module SpecEMultipleTys where
+
+bar :: Num a => a -> a -> a
+bar x y = 2 * ( x + y )
+
+-- The "specialise expression" syntax doesn't support multiple type ascriptions.
+{-# SPECIALISE bar 3 :: Float -> Float, Double -> Double #-}


=====================================
testsuite/tests/warnings/should_fail/SpecEMultipleTys.stderr
=====================================
@@ -0,0 +1,5 @@
+SpecEMultipleTys.hs:10:22: error: [GHC-62037]
+    SPECIALISE expression doesn't support multiple type ascriptions
+    Suggested fix:
+      Split the SPECIALISE pragma into multiple pragmas, one for each type signature
+


=====================================
testsuite/tests/warnings/should_fail/all.T
=====================================
@@ -27,3 +27,4 @@ test('WarningCategory6', [extra_files(['WarningCategory1.hs', 'WarningCategory1_
 test('WarningCategory7', [extra_files(['WarningCategory1.hs', 'WarningCategory1_B.hs', 'WarningCategoryModule.hs'])], multimod_compile_fail, ['WarningCategory1', '-v0 -Werror -w -Wall'])
 test('WarningCategoryInvalid', normal, compile_fail, [''])
 test('T24396c', normal, compile_fail, [''])
+test('SpecEMultipleTys', normal, compile_fail, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea70f1d949d993eddf1747b36e836a6c3fc47c33

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea70f1d949d993eddf1747b36e836a6c3fc47c33
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241202/ba34e40f/attachment-0001.html>


More information about the ghc-commits mailing list