INLINE pragma for patterns (#12178)

Allow INLINE and NOINLINE pragmas to be used for patterns.
Those are applied to both the builder and matcher (where applicable).

compiler/GHC/Parser.y

@@ -476,6 +476,23 @@ Ambiguity:
     the -XTransformListComp extension.
 -}
 
+{- Note [%shift: activation -> {- empty -}]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Context:
+    sigdecl -> '{-# INLINE' . activation qvarcon '#-}'
+    activation -> {- empty -}
+    activation -> explicit_activation
+
+Example:
+
+    {-# INLINE [0] Something #-}
+
+Ambiguity:
+    We don't know whether the '[' is the start of the activation or the beginning
+    of the [] data constructor.
+    We parse this as having '[0]' activation for inlining 'Something', rather than
+    empty activation and inlining '[0] Something'.
+-}
 
 {- Note [Parser API Annotations]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1605,6 +1622,10 @@ pattern_synonym_sig :: { LSig GhcPs }
                    {% ams (sLL $1 $> $ PatSynSig noExtField (unLoc $2) $4)
                           [mj AnnPattern $1, mu AnnDcolon $3] }
 
+qvarcon :: { Located RdrName }
+        : qvar                          { $1 }
+        | qcon                          { $1 }
+
 -----------------------------------------------------------------------------
 -- Nested declarations
 
@@ -2504,7 +2525,7 @@ sigdecl :: { LHsDecl GhcPs }
                     ([ mo $1 ] ++ dcolon ++ [mc $4]) }
 
         -- This rule is for both INLINE and INLINABLE pragmas
-        | '{-# INLINE' activation qvar '#-}'
+        | '{-# INLINE' activation qvarcon '#-}'
                 {% ams ((sLL $1 $> $ SigD noExtField (InlineSig noExtField $3
                             (mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1)
                                             (snd $2)))))
@@ -2544,7 +2565,8 @@ sigdecl :: { LHsDecl GhcPs }
                    [mo $1,mc $3] }
 
 activation :: { ([AddAnn],Maybe Activation) }
-        : {- empty -}                           { ([],Nothing) }
+        : -- See Note [%shift: activation -> {- empty -}]
+          {- empty -} %shift                    { ([],Nothing) }
         | explicit_activation                   { (fst $1,Just (snd $1)) }
 
 explicit_activation :: { ([AddAnn],Activation) }  -- In brackets

compiler/GHC/Tc/Gen/Bind.hs

@@ -445,10 +445,10 @@ tc_single :: forall thing.
             TopLevelFlag -> TcSigFun -> TcPragEnv
           -> LHsBind GhcRn -> IsGroupClosed -> TcM thing
           -> TcM (LHsBinds GhcTc, thing)
-tc_single _top_lvl sig_fn _prag_fn
+tc_single _top_lvl sig_fn prag_fn
           (L _ (PatSynBind _ psb@PSB{ psb_id = L _ name }))
           _ thing_inside
-  = do { (aux_binds, tcg_env) <- tcPatSynDecl psb (sig_fn name)
+  = do { (aux_binds, tcg_env) <- tcPatSynDecl psb (sig_fn name) prag_fn
        ; thing <- setGblEnv tcg_env thing_inside
        ; return (aux_binds, thing)
        }

compiler/GHC/Tc/TyCl/PatSyn.hs

@@ -26,7 +26,7 @@ import GHC.Core.Multiplicity
 import GHC.Core.Type ( tidyTyCoVarBinders, tidyTypes, tidyType )
 import GHC.Core.TyCo.Subst( extendTvSubstWithClone )
 import GHC.Tc.Utils.Monad
-import GHC.Tc.Gen.Sig( emptyPragEnv, completeSigFromId )
+import GHC.Tc.Gen.Sig ( TcPragEnv, emptyPragEnv, completeSigFromId, lookupPragEnv, addInlinePrags )
 import GHC.Tc.Utils.Env
 import GHC.Tc.Utils.TcMType
 import GHC.Tc.Utils.Zonk
@@ -76,12 +76,13 @@ import Data.List( partition, mapAccumL )
 
 tcPatSynDecl :: PatSynBind GhcRn GhcRn
              -> Maybe TcSigInfo
+             -> TcPragEnv -- See Note [Pragmas for pattern synonyms]
              -> TcM (LHsBinds GhcTc, TcGblEnv)
-tcPatSynDecl psb mb_sig
+tcPatSynDecl psb mb_sig prag_fn
   = recoverM (recoverPSB psb) $
     case mb_sig of
-      Nothing                 -> tcInferPatSynDecl psb
-      Just (TcPatSynSig tpsi) -> tcCheckPatSynDecl psb tpsi
+      Nothing                 -> tcInferPatSynDecl psb prag_fn
+      Just (TcPatSynSig tpsi) -> tcCheckPatSynDecl psb tpsi prag_fn
       _                       -> panic "tcPatSynDecl"
 
 recoverPSB :: PatSynBind GhcRn GhcRn
@@ -138,9 +139,11 @@ pattern.) But it'll do for now.
 -}
 
 tcInferPatSynDecl :: PatSynBind GhcRn GhcRn
+                  -> TcPragEnv
                   -> TcM (LHsBinds GhcTc, TcGblEnv)
 tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details
                        , psb_def = lpat, psb_dir = dir })
+                  prag_fn
   = addPatSynCtxt lname $
     do { traceTc "tcInferPatSynDecl {" $ ppr name
 
@@ -184,7 +187,7 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details
        ; mapM_ dependentArgErr bad_args
 
        ; traceTc "tcInferPatSynDecl }" $ (ppr name $$ ppr ex_tvs)
-       ; tc_patsyn_finish lname dir is_infix lpat'
+       ; tc_patsyn_finish lname dir is_infix lpat' prag_fn
                           (mkTyVarBinders InferredSpec univ_tvs
                             , req_theta,  ev_binds, req_dicts)
                           (mkTyVarBinders InferredSpec ex_tvs
@@ -342,6 +345,7 @@ is not very helpful, but at least we don't get a Lint error.
 
 tcCheckPatSynDecl :: PatSynBind GhcRn GhcRn
                   -> TcPatSynInfo
+                  -> TcPragEnv
                   -> TcM (LHsBinds GhcTc, TcGblEnv)
 tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
                          , psb_def = lpat, psb_dir = dir }
@@ -349,6 +353,7 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
                       , patsig_univ_bndrs = explicit_univ_bndrs, patsig_req  = req_theta
                       , patsig_ex_bndrs   = explicit_ex_bndrs,   patsig_prov = prov_theta
                       , patsig_body_ty    = sig_body_ty }
+                  prag_fn
   = addPatSynCtxt lname $
     do { traceTc "tcCheckPatSynDecl" $
          vcat [ ppr implicit_bndrs, ppr explicit_univ_bndrs, ppr req_theta
@@ -440,7 +445,7 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
 
        ; traceTc "tcCheckPatSynDecl }" $ ppr name
 
-       ; tc_patsyn_finish lname dir is_infix lpat'
+       ; tc_patsyn_finish lname dir is_infix lpat' prag_fn
                           (skol_univ_bndrs, skol_req_theta, ev_binds, req_dicts)
                           (skol_ex_bndrs, mkTyVarTys ex_tvs', skol_prov_theta, prov_dicts)
                           (args', skol_arg_tys)
@@ -659,6 +664,7 @@ tc_patsyn_finish :: Located Name      -- ^ PatSyn Name
                  -> HsPatSynDir GhcRn -- ^ PatSyn type (Uni/Bidir/ExplicitBidir)
                  -> Bool              -- ^ Whether infix
                  -> LPat GhcTc        -- ^ Pattern of the PatSyn
+                 -> TcPragEnv
                  -> ([TcInvisTVBinder], [PredType], TcEvBinds, [EvVar])
                  -> ([TcInvisTVBinder], [TcType], [PredType], [EvTerm])
                  -> ([LHsExpr GhcTc], [TcType])  -- ^ Pattern arguments and types
@@ -666,7 +672,7 @@ tc_patsyn_finish :: Located Name      -- ^ PatSyn Name
                  -> [Name]            -- ^ Selector names
                  -- ^ Whether fields, empty if not record PatSyn
                  -> TcM (LHsBinds GhcTc, TcGblEnv)
-tc_patsyn_finish lname dir is_infix lpat'
+tc_patsyn_finish lname dir is_infix lpat' prag_fn
                  (univ_tvs, req_theta, req_ev_binds, req_dicts)
                  (ex_tvs,   ex_tys,    prov_theta,   prov_dicts)
                  (args, arg_tys)
@@ -697,7 +703,7 @@ tc_patsyn_finish lname dir is_infix lpat'
            ppr pat_ty
 
        -- Make the 'matcher'
-       ; (matcher_id, matcher_bind) <- tcPatSynMatcher lname lpat'
+       ; (matcher_id, matcher_bind) <- tcPatSynMatcher lname lpat' prag_fn
                                          (binderVars univ_tvs, req_theta, req_ev_binds, req_dicts)
                                          (binderVars ex_tvs, ex_tys, prov_theta, prov_dicts)
                                          (args, arg_tys)
@@ -707,7 +713,7 @@ tc_patsyn_finish lname dir is_infix lpat'
        ; builder_id <- mkPatSynBuilderId dir lname
                                          univ_tvs req_theta
                                          ex_tvs   prov_theta
-                                         arg_tys pat_ty
+                                         arg_tys pat_ty prag_fn
 
          -- TODO: Make this have the proper information
        ; let mkFieldLabel name = FieldLabel { flLabel = occNameFS (nameOccName name)
@@ -744,13 +750,14 @@ tc_patsyn_finish lname dir is_infix lpat'
 
 tcPatSynMatcher :: Located Name
                 -> LPat GhcTc
+                -> TcPragEnv
                 -> ([TcTyVar], ThetaType, TcEvBinds, [EvVar])
                 -> ([TcTyVar], [TcType], ThetaType, [EvTerm])
                 -> ([LHsExpr GhcTc], [TcType])
                 -> TcType
                 -> TcM ((Id, Bool), LHsBinds GhcTc)
 -- See Note [Matchers and builders for pattern synonyms] in GHC.Core.PatSyn
-tcPatSynMatcher (L loc name) lpat
+tcPatSynMatcher (L loc name) lpat prag_fn
                 (univ_tvs, req_theta, req_ev_binds, req_dicts)
                 (ex_tvs, ex_tys, prov_theta, prov_dicts)
                 (args, arg_tys) pat_ty
@@ -813,17 +820,19 @@ tcPatSynMatcher (L loc name) lpat
                     , mg_ext = MatchGroupTc [] res_ty
                     , mg_origin = Generated
                     }
+             prags = lookupPragEnv prag_fn name
+             -- See Note [Pragmas for pattern synonyms]
 
-       ; let bind = FunBind{ fun_id = L loc matcher_id
+       ; matcher_prag_id <- addInlinePrags matcher_id prags
+       ; let bind = FunBind{ fun_id = L loc matcher_prag_id
                            , fun_matches = mg
                            , fun_ext = idHsWrapper
                            , fun_tick = [] }
              matcher_bind = unitBag (noLoc bind)
-
        ; traceTc "tcPatSynMatcher" (ppr name $$ ppr (idType matcher_id))
        ; traceTc "tcPatSynMatcher" (ppr matcher_bind)
 
-       ; return ((matcher_id, is_unlifted), matcher_bind) }
+       ; return ((matcher_prag_id, is_unlifted), matcher_bind) }
 
 mkPatSynRecSelBinds :: PatSyn
                     -> [FieldLabel]  -- ^ Visible field labels
@@ -849,10 +858,11 @@ mkPatSynBuilderId :: HsPatSynDir a -> Located Name
                   -> [InvisTVBinder] -> ThetaType
                   -> [InvisTVBinder] -> ThetaType
                   -> [Type] -> Type
+                  -> TcPragEnv
                   -> TcM (Maybe (Id, Bool))
 mkPatSynBuilderId dir (L _ name)
                   univ_bndrs req_theta ex_bndrs prov_theta
-                  arg_tys pat_ty
+                  arg_tys pat_ty prag_fn
   | isUnidirectional dir
   = return Nothing
   | otherwise
@@ -869,8 +879,11 @@ mkPatSynBuilderId dir (L _ name)
               -- See Note [Exported LocalIds] in GHC.Types.Id
 
              builder_id'    = modifyIdInfo (`setLevityInfoWithType` pat_ty) builder_id
+             prags          = lookupPragEnv prag_fn name
+             -- See Note [Pragmas for pattern synonyms]
 
-       ; return (Just (builder_id', need_dummy_arg)) }
+       ; builder_prag_id <- addInlinePrags builder_id' prags
+       ; return (Just (builder_prag_id, need_dummy_arg)) }
 
 tcPatSynBuilderBind :: PatSynBind GhcRn GhcRn
                     -> TcM (LHsBinds GhcTc)
@@ -1141,12 +1154,34 @@ converting the pattern to an expression (for the builder RHS) we
 simply discard the signature.
 
 Note [Record PatSyn Desugaring]
--------------------------------
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 It is important that prov_theta comes before req_theta as this ordering is used
 when desugaring record pattern synonym updates.
 
 Any change to this ordering should make sure to change GHC.HsToCore.Expr if you
 want to avoid difficult to decipher core lint errors!
+
+Note [Pragmas for pattern synonyms]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+INLINE and NOINLINE pragmas are supported for pattern synonyms. They affect both
+the matcher and the builder.
+(See Note [Matchers and builders for pattern synonyms] in PatSyn)
+
+For example:
+    pattern InlinedPattern x = [x]
+    {-# INLINE InlinedPattern #-}
+    pattern NonInlinedPattern x = [x]
+    {-# NOINLINE NonInlinedPattern #-}
+
+For pattern synonyms with explicit builders, only pragma for the entire pattern
+synonym is supported. For example:
+    pattern HeadC x <- x:xs where
+      HeadC x = [x]
+      -- This wouldn't compile: {-# INLINE HeadC #-}
+    {-# INLINE HeadC #-} -- But this works
+
+When no pragma is provided for a pattern, the inlining decision might change
+between different versions of GHC.
  -}
 
 

compiler/GHC/Tc/TyCl/PatSyn.hs-boot

@@ -5,9 +5,11 @@ import GHC.Tc.Types ( TcM, TcSigInfo )
 import GHC.Tc.Utils.Monad ( TcGblEnv)
 import GHC.Hs.Extension ( GhcRn, GhcTc )
 import Data.Maybe  ( Maybe )
+import GHC.Tc.Gen.Sig ( TcPragEnv )
 
 tcPatSynDecl :: PatSynBind GhcRn GhcRn
              -> Maybe TcSigInfo
+             -> TcPragEnv
              -> TcM (LHsBinds GhcTc, TcGblEnv)
 
 tcPatSynBuilderBind :: PatSynBind GhcRn GhcRn -> TcM (LHsBinds GhcTc)

docs/users_guide/exts/pattern_synonyms.rst

@@ -520,4 +520,38 @@ below:
     *Main> g (False:undefined)
     False
 
+Pragmas for pattern synonyms
+----------------------------
+
+The :ref:`inlinable-pragma`, :ref:`inline-pragma` and :ref:`noinline-pragma` are supported for pattern
+synonyms. For example: ::
+
+    patternInlinablePattern x = [x]
+    {-# INLINABLE InlinablePattern #-}
+    pattern InlinedPattern x = [x]
+    {-# INLINE InlinedPattern #-}
+    pattern NonInlinedPattern x = [x]
+    {-# NOINLINE NonInlinedPattern #-}
+
+As with other ``INLINABLE``, ``INLINE`` and ``NOINLINE`` pragmas, it's possible to specify
+to which phase the pragma applies: ::
+
+    pattern Q x = [x]
+    {-# NOINLINE[1] Q #-}
+
+The pragmas are applied both when the pattern is used as a matcher, and as a
+data constructor. For explicitly bidirectional pattern synonyms, the pragma
+must be at top level, not nested in the where clause. For example, this won't compile: ::
+
+    pattern HeadC x <- x:xs where
+      HeadC x = [x]
+      {-# INLINE HeadC #-}
+
+but this will: ::
+
+    pattern HeadC x <- x:xs where
+      HeadC x = [x]
+    {-# INLINE HeadC #-}
 
+When no pragma is provided for a pattern, the inlining decision is made by
+GHC's own inlining heuristics.

testsuite/tests/typecheck/should_compile/InlinePatSyn_ExplicitBidiBuilder.hs

+{-# LANGUAGE PatternSynonyms #-}
+
+module InlinePatSyn_ExplicitBidiBuilder where
+
+-- Explicit bidirectional pattern
+pattern ExplicitPattern x <- x:xs where
+  ExplicitPattern x = [x]
+{-# INLINE ExplicitPattern #-}
+
+testExplicitBuilder x = ExplicitPattern (x+1)

testsuite/tests/typecheck/should_compile/InlinePatSyn_ExplicitBidiMatcher.hs

+{-# LANGUAGE PatternSynonyms #-}
+
+module InlinePatSyn_ExplicitBidiMatcher where
+
+-- Explicit bidirectional pattern
+pattern ExplicitPattern x <- x:xs where
+  ExplicitPattern x = [x]
+{-# INLINE ExplicitPattern #-}
+
+testMatcherofExplicitBuilder (ExplicitPattern x) = 1
+testMatcherofExplicitBuilder _  = 2

testsuite/tests/typecheck/should_compile/InlinePatSyn_InlinableBuilder.hs

+{-# LANGUAGE PatternSynonyms #-}
+
+module InlinePatSyn_InlinableBuilder where
+
+-- Pattern with "INLINE" pragma, both builder and matcher should be inlined
+pattern InlinablePattern a = [[[[a]]]]
+{-# INLINABLE InlinablePattern #-}
+
+testInBuilder x = InlinablePattern (x+1)

testsuite/tests/typecheck/should_compile/InlinePatSyn_InlinableMatcher.hs

+{-# LANGUAGE PatternSynonyms #-}
+
+module InlinePatSyn_InlinableMatcher where
+
+-- Pattern with "INLINE" pragma, both builder and matcher should be inlined
+pattern InlinablePattern a = [[[[a]]]]
+{-# INLINEABLE InlinablePattern #-}
+
+testInMatcher (InlinablePattern x) = 1
+testInMatcher _ = 2

testsuite/tests/typecheck/should_compile/InlinePatSyn_InlineBuilder.hs

+{-# LANGUAGE PatternSynonyms #-}
+
+module InlinePatSyn_InlineBuilder where
+
+-- Pattern with "INLINE" pragma, both builder and matcher should be inlined
+pattern InlinePattern a = [[[[a]]]]
+{-# INLINE InlinePattern #-}
+
+testInBuilder x = InlinePattern (x+1)

testsuite/tests/typecheck/should_compile/InlinePatSyn_InlineMatcher.hs

+{-# LANGUAGE PatternSynonyms #-}
+
+module InlinePatSyn_InlineMatcher where
+
+-- Pattern with "INLINE" pragma, both builder and matcher should be inlined
+pattern InlinePattern a = [[[[a]]]]
+{-# INLINE InlinePattern #-}
+
+testInMatcher (InlinePattern x) = 1
+testInMatcher _ = 2

testsuite/tests/typecheck/should_compile/InlinePatSyn_NoInlineBuilder.hs

+{-# LANGUAGE PatternSynonyms #-}
+
+module InlinePatSyn_NoInlineBuilder where
+
+-- Pattern with "NOINLINE" pragma, neither builder nor matcher should be inlined
+pattern NonInlinablePattern a = Left a
+{-# NOINLINE NonInlinablePattern #-}
+
+testNonBuilder x = NonInlinablePattern (x+1)

testsuite/tests/typecheck/should_compile/InlinePatSyn_NoInlineMatcher.hs

+{-# LANGUAGE PatternSynonyms #-}
+
+module T12178 where
+
+-- Pattern with "NOINLINE" pragma, neither builder nor matcher should be inlined
+pattern NonInlinablePattern a = Left a
+{-# NOINLINE NonInlinablePattern #-}
+
+testNonMatcher (NonInlinablePattern x) = 1
+testNonMatcher _ = 2

testsuite/tests/typecheck/should_compile/Makefile

@@ -80,3 +80,40 @@ T17566:
 	$(RM) -f T17566a.o T17566a.hi T17566.o T17566.hi
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c T17566a.hs
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c T17566.hs
+
+# In the InlinePatSyn tests, we're interested in whether the pattern synonym (whose name always contains the string 'Pattern').
+# is inlined or not. In order to check, we use sed to isolate lines between the start and end of the test definition. That is,
+# from a line starting with 'test', to a blank line. We then use grep to determine if 'Pattern' occurs anywhere in the definition
+# in the core. If it was inlined, it naturally won't occur, so grep -v will succeed, if it wasn't then plain grep will succeed.
+
+InlinePatSyn_InlinableBuilder:
+	$(RM) -f InlinePatSyn_InlinableBuilder.o InlinePatSyn_InlinableBuilder.hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c InlinePatSyn_InlinableBuilder.hs  -O -dsuppress-all -ddump-hi | grep -q 'Inline:'
+
+InlinePatSyn_InlinableMatcher:
+	$(RM) -f InlinePatSyn_InlinableMatcher.o InlinePatSyn_InlinableMatcher.hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c InlinePatSyn_InlinableMatcher.hs  -O -dsuppress-all -ddump-hi | grep -q 'Inline:'
+
+InlinePatSyn_InlineBuilder:
+	$(RM) -f InlinePatSyn_InlineBuilder.o InlinePatSyn_InlineBuilder.hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c InlinePatSyn_InlineBuilder.hs  -O -dsuppress-all -ddump-simpl | sed -n '/^test/,/^$$/p' | grep -vq 'Pattern'
+
+InlinePatSyn_InlineMatcher:
+	$(RM) -f InlinePatSyn_InlineMatcher.o InlinePatSyn_InlineMatcher.hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c InlinePatSyn_InlineMatcher.hs  -O -dsuppress-all -ddump-simpl | sed -n '/^test/,/^$$/p' | grep -vq 'Pattern'
+
+InlinePatSyn_NoInlineBuilder:
+	$(RM) -f InlinePatSyn_NoInlineBuilder.o InlinePatSyn_NoInlineBuilder.hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c InlinePatSyn_NoInlineBuilder.hs  -O -dsuppress-all -ddump-simpl | sed -n '/^test/,/^$$/p' | grep -q 'Pattern'
+
+InlinePatSyn_NoInlineMatcher:
+	$(RM) -f InlinePatSyn_NoInlineMatcher.o InlinePatSyn_NoInlineMatcher.hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c InlinePatSyn_NoInlineMatcher.hs  -O -dsuppress-all -ddump-simpl | sed -n '/^test/,/^$$/p' | grep -q 'Pattern'
+
+InlinePatSyn_ExplicitBidiBuilder:
+	$(RM) -f InlinePatSyn_ExplicitBidiBuilder.o InlinePatSyn_ExplicitBidiBuilder.hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c InlinePatSyn_ExplicitBidiBuilder.hs  -O -dsuppress-all -ddump-simpl | sed -n '/^test/,/^$$/p' | grep -vq 'Pattern'
+
+InlinePatSyn_ExplicitBidiMatcher:
+	$(RM) -f InlinePatSyn_ExplicitBidiMatcher.o InlinePatSyn_ExplicitBidiMatcher.hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c InlinePatSyn_ExplicitBidiMatcher.hs  -O -dsuppress-all -ddump-simpl | sed -n '/^test/,/^$$/p' | grep -vq 'Pattern'

testsuite/tests/typecheck/should_compile/all.T

@@ -730,3 +730,12 @@ test('T18939_Compile', normal, compile, [''])
 test('T15942', normal, compile, [''])
 test('ClassDefaultInHsBoot', [extra_files(['ClassDefaultInHsBootA1.hs','ClassDefaultInHsBootA2.hs','ClassDefaultInHsBootA2.hs-boot','ClassDefaultInHsBootA3.hs'])], multimod_compile, ['ClassDefaultInHsBoot', '-v0'])
 test('T17186', normal, compile, [''])
+test('InlinePatSyn_InlinableBuilder', [], makefile_test, [])
+test('InlinePatSyn_InlinableMatcher', [], makefile_test, [])
+test('InlinePatSyn_InlineBuilder', [], makefile_test, [])
+test('InlinePatSyn_InlineMatcher', [], makefile_test, [])
+test('InlinePatSyn_NoInlineBuilder', [], makefile_test, [])
+test('InlinePatSyn_NoInlineMatcher', [], makefile_test, [])
+test('InlinePatSyn_ExplicitBidiBuilder', [], makefile_test, [])
+test('InlinePatSyn_ExplicitBidiMatcher', [], makefile_test, [])
+

testsuite/tests/typecheck/should_fail/T12178a.hs

+{-# LANGUAGE PatternSynonyms #-}
+
+module T12178a where
+
+-- Trying to inline a data constructor fails
+data L a = C a (L a) | T
+{-# INLINE C #-}

testsuite/tests/typecheck/should_fail/T12178a.stderr

+
+T12178a.hs:7:12: error:
+    The INLINE pragma for ‘C’ lacks an accompanying binding
+      (The INLINE pragma must be given where ‘C’ is declared)

testsuite/tests/typecheck/should_fail/all.T

@@ -590,3 +590,5 @@ test('T18640b', normal, compile_fail, [''])
 test('T18640c', normal, compile_fail, [''])
 test('T10709', normal, compile_fail, [''])
 test('T10709b', normal, compile_fail, [''])
+test('T12178a', normal, compile_fail, [''])
+