[Git][ghc/ghc][master] 3 commits: Add an extension field to HsRecFields

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Tue Aug 13 17:38:30 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
51ffba5d by Arnaud Spiwack at 2024-08-13T13:37:50-04:00
Add an extension field to HsRecFields

This is the Right Thing to Do™. And it prepares for storing a
multiplicity coercion there.

First step of the plan outlined here and below
https://gitlab.haskell.org/ghc/ghc/-/merge_requests/12947#note_573091

- - - - -
4d2faeeb by Arnaud Spiwack at 2024-08-13T13:37:50-04:00
Add test for #24961

- - - - -
623b4337 by Arnaud Spiwack at 2024-08-13T13:37:50-04:00
Ensures that omitted record fields in pattern have multiplicity Many

Omitted fields were simply ignored in the type checker and produced
incorrect Core code.

Fixes #24961

Metric Increase:
    RecordUpdPerf

- - - - -


29 changed files:

- compiler/GHC/Hs/Pat.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/HsToCore/Utils.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/ThToHs.hs
- compiler/Language/Haskell/Syntax/Pat.hs
- + testsuite/tests/linear/should_compile/OmitFieldPat.hs
- testsuite/tests/linear/should_compile/all.T
- + testsuite/tests/linear/should_fail/T24961.hs
- + testsuite/tests/linear/should_fail/T24961.stderr
- testsuite/tests/linear/should_fail/all.T
- utils/check-exact/ExactPrint.hs


Changes:

=====================================
compiler/GHC/Hs/Pat.hs
=====================================
@@ -191,6 +191,10 @@ type instance XConPatTyArg GhcPs = EpToken "@"
 type instance XConPatTyArg GhcRn = NoExtField
 type instance XConPatTyArg GhcTc = NoExtField
 
+type instance XHsRecFields GhcPs = NoExtField
+type instance XHsRecFields GhcRn = NoExtField
+type instance XHsRecFields GhcTc = MultiplicityCheckCoercions
+
 type instance XHsFieldBind _ = [AddEpAnn]
 
 type instance XInvisPat GhcPs = EpToken "@"


=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -1359,7 +1359,7 @@ dsHsWrapper (WpEvApp tm)      k = do { core_tm <- dsEvTerm tm
                                            is_unspecable_var v = v `S.member` unspecables
                                            is_specable = not $ any (is_unspecable_var) vs -- See Note [Desugaring non-canonical evidence]
                                      ; k (\e -> app_ev is_specable e core_tm) }
-  -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+  -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
 dsHsWrapper (WpMultCoercion co) k = do { unless (isReflexiveCo co) $
                                            diagnosticDs DsMultiplicityCoercionsNotSupported
                                        ; k $ \e -> e }


=====================================
compiler/GHC/HsToCore/Pmc/Desugar.hs
=====================================
@@ -37,7 +37,7 @@ import GHC.Core.Coercion
 import GHC.Tc.Types.Evidence (HsWrapper(..), isIdHsWrapper)
 import {-# SOURCE #-} GHC.HsToCore.Expr (dsExpr, dsLExpr, dsSyntaxExpr)
 import {-# SOURCE #-} GHC.HsToCore.Binds (dsHsWrapper)
-import GHC.HsToCore.Utils (isTrueLHsExpr, selectMatchVar, decideBangHood)
+import GHC.HsToCore.Utils (isTrueLHsExpr, selectMatchVar, decideBangHood, checkMultiplicityCoercions)
 import GHC.HsToCore.Match.Literal (dsLit, dsOverLit)
 import GHC.HsToCore.Monad
 import GHC.Core.TyCo.Rep
@@ -271,7 +271,9 @@ desugarConPatOut :: Id -> ConLike -> [Type] -> [TyVar]
 desugarConPatOut x con univ_tys ex_tvs dicts = \case
     PrefixCon _ ps               -> go_field_pats (zip [0..] ps)
     InfixCon  p1 p2              -> go_field_pats (zip [0..] [p1,p2])
-    RecCon    (HsRecFields fs _) -> go_field_pats (rec_field_ps fs)
+    RecCon    (HsRecFields mult_cos fs _) -> do
+      checkMultiplicityCoercions mult_cos
+      go_field_pats (rec_field_ps fs)
   where
     -- The actual argument types (instantiated)
     arg_tys     = map scaledThing $ conLikeInstOrigArgTys con (univ_tys ++ mkTyVarTys ex_tvs)


=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -975,9 +975,9 @@ addTickCmdStmt (XStmtLR (ApplicativeStmt{})) =
 addTickCmdStmt stmt  = pprPanic "addTickHsCmd" (ppr stmt)
 
 addTickHsRecordBinds :: HsRecordBinds GhcTc -> TM (HsRecordBinds GhcTc)
-addTickHsRecordBinds (HsRecFields fields dd)
+addTickHsRecordBinds (HsRecFields x fields dd)
   = do  { fields' <- mapM addTickHsRecField fields
-        ; return (HsRecFields fields' dd) }
+        ; return (HsRecFields x fields' dd) }
 
 addTickHsRecField :: LHsFieldBind GhcTc id (LHsExpr GhcTc)
                   -> TM (LHsFieldBind GhcTc id (LHsExpr GhcTc))


=====================================
compiler/GHC/HsToCore/Utils.hs
=====================================
@@ -42,6 +42,9 @@ module GHC.HsToCore.Utils (
         selectSimpleMatchVarL, selectMatchVars, selectMatchVar,
         mkOptTickBox, mkBinaryTickBox, decideBangHood,
         isTrueLHsExpr,
+
+        -- Multiplicity
+        checkMultiplicityCoercions,
     ) where
 
 import GHC.Prelude
@@ -55,6 +58,7 @@ import GHC.Hs
 import GHC.Hs.Syn.Type
 import GHC.Core
 import GHC.HsToCore.Monad
+import GHC.HsToCore.Errors.Types
 
 import GHC.Core.Utils
 import GHC.Core.Make
@@ -84,7 +88,7 @@ import qualified GHC.LanguageExtensions as LangExt
 
 import GHC.Tc.Types.Evidence
 
-import Control.Monad    ( zipWithM )
+import Control.Monad    ( unless, zipWithM )
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Maybe (maybeToList)
 import qualified Data.List.NonEmpty as NEL
@@ -1103,3 +1107,9 @@ isTrueLHsExpr (L _ (XExpr (HsBinTick ixT _ e)))
 
 isTrueLHsExpr (L _ (HsPar _ e)) = isTrueLHsExpr e
 isTrueLHsExpr _                 = Nothing
+
+-- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
+checkMultiplicityCoercions :: MultiplicityCheckCoercions -> DsM ()
+checkMultiplicityCoercions cos =
+  unless (all isReflexiveCo cos) $
+    diagnosticDs DsMultiplicityCoercionsNotSupported


=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -1068,7 +1068,7 @@ instance HiePass p => ToHie (PScoped (LocatedA (Pat (GhcPass p)))) where
       contextify (InfixCon a b) = InfixCon a' b'
         where [a', b'] = patScopes rsp scope pscope [a,b]
       contextify (RecCon r) = RecCon $ RC RecFieldMatch $ contextify_rec r
-      contextify_rec (HsRecFields fds a) = HsRecFields (map go scoped_fds) a
+      contextify_rec (HsRecFields x fds a) = HsRecFields x (map go scoped_fds) a
         where
           go :: RScoped (LocatedA (HsFieldBind id a1))
                       -> LocatedA (HsFieldBind id (PScoped a1)) -- AZ
@@ -1464,7 +1464,7 @@ instance HiePass p => ToHie (RScoped (NHsValBindsLR (GhcPass p))) where
 
 instance ( ToHie arg , HasLoc arg , Data arg
          , HiePass p ) => ToHie (RContext (HsRecFields (GhcPass p) arg)) where
-  toHie (RC c (HsRecFields fields _)) = toHie $ map (RC c) fields
+  toHie (RC c (HsRecFields _ fields _)) = toHie $ map (RC c) fields
 
 instance ( ToHie (RFContext label)
          , ToHie arg, HasLoc arg, Data arg


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -2278,13 +2278,13 @@ mkPatRec ::
   HsRecFields GhcPs (LocatedA (PatBuilder GhcPs)) ->
   [AddEpAnn] ->
   PV (PatBuilder GhcPs)
-mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd) anns
+mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields x fs dd) anns
   | isRdrDataCon (unLoc c)
   = do fs <- mapM checkPatField fs
        return $ PatBuilderPat $ ConPat
          { pat_con_ext = anns
          , pat_con = c
-         , pat_args = RecCon (HsRecFields fs dd)
+         , pat_args = RecCon (HsRecFields x fs dd)
          }
 mkPatRec p _ _ =
   addFatalError $ mkPlainErrorMsgEnvelope (getLocA p) $
@@ -2946,9 +2946,9 @@ mkRdrRecordCon
 mkRdrRecordCon con flds anns
   = RecordCon { rcon_ext = anns, rcon_con = con, rcon_flds = flds }
 
-mk_rec_fields :: [LocatedA (HsRecField (GhcPass p) arg)] -> Maybe SrcSpan -> HsRecFields (GhcPass p) arg
-mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
-mk_rec_fields fs (Just s)  = HsRecFields { rec_flds = fs
+mk_rec_fields :: [LocatedA (HsRecField GhcPs arg)] -> Maybe SrcSpan -> HsRecFields GhcPs arg
+mk_rec_fields fs Nothing = HsRecFields { rec_ext = noExtField, rec_flds = fs, rec_dotdot = Nothing }
+mk_rec_fields fs (Just s)  = HsRecFields { rec_ext = noExtField, rec_flds = fs
                                      , rec_dotdot = Just (L (l2l s) (RecFieldsDotDot $ length fs)) }
 
 mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs GhcPs


=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -543,7 +543,7 @@ rnExpr (RecordCon { rcon_con = con_id
   = do { con_lname@(L _ con_name) <- lookupLocatedOccRnConstr con_id
        ; (flds, fvs)   <- rnHsRecFields (HsRecFieldCon con_name) mk_hs_var rec_binds
        ; (flds', fvss) <- mapAndUnzipM rn_field flds
-       ; let rec_binds' = HsRecFields { rec_flds = flds', rec_dotdot = dd }
+       ; let rec_binds' = HsRecFields { rec_ext = noExtField, rec_flds = flds', rec_dotdot = dd }
        ; return (RecordCon { rcon_ext = noExtField
                            , rcon_con = con_lname, rcon_flds = rec_binds' }
                 , fvs `plusFV` plusFVs fvss `addOneFV` con_name) }


=====================================
compiler/GHC/Rename/Pat.hs
=====================================
@@ -776,7 +776,7 @@ rnHsRecPatsAndThen mk (L _ con)
                                             hs_rec_fields
        ; flds' <- mapM rn_field (flds `zip` [1..])
        ; check_unused_wildcard (lHsRecFieldsImplicits flds' <$> unLoc <$> dd)
-       ; return (HsRecFields { rec_flds = flds', rec_dotdot = dd }) }
+       ; return (HsRecFields { rec_ext = noExtField, rec_flds = flds', rec_dotdot = dd }) }
   where
     mkVarPat l n = VarPat noExtField (L (noAnnSrcSpan l) n)
     rn_field (L l fld, n') =


=====================================
compiler/GHC/Tc/Deriv/Generate.hs
=====================================
@@ -604,7 +604,8 @@ nlConWildPat con = noLocA $ ConPat
   { pat_con_ext = noAnn
   , pat_con = noLocA $ getRdrName con
   , pat_args = RecCon $ HsRecFields
-      { rec_flds = []
+      { rec_ext = noExtField
+      , rec_flds = []
       , rec_dotdot = Nothing }
   }
 


=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -1182,6 +1182,7 @@ reportGroup mk_err ctxt items
 -- See Note [No deferring for multiplicity errors]
 nonDeferrableOrigin :: CtOrigin -> Bool
 nonDeferrableOrigin (NonLinearPatternOrigin {}) = True
+nonDeferrableOrigin (OmittedFieldOrigin {}) = True
 nonDeferrableOrigin (UsageEnvironmentOf {}) = True
 nonDeferrableOrigin (FRROrigin {})          = True
 nonDeferrableOrigin _                       = False
@@ -1368,7 +1369,7 @@ With #10283, you can now opt out of deferred type error warnings.
 
 Note [No deferring for multiplicity errors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-As explained in Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify,
+As explained in Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify,
 linear types do not support casts and any nontrivial coercion will raise
 an error during desugaring.
 
@@ -1378,8 +1379,7 @@ by the desugarer would shadow the type mismatch warnings (#20083).
 As a solution, we refuse to defer submultiplicity constraints. Test: T20083.
 
 To determine whether a constraint arose from a submultiplicity check, we
-look at the CtOrigin. All calls to tcSubMult use one of two origins,
-UsageEnvironmentOf and NonLinearPatternOrigin. Those origins are not
+look at the CtOrigin. All calls to tcSubMult use origins which are not
 used outside of linear types.
 
 In the future, we should compile 'WpMultCoercion' to a runtime error with


=====================================
compiler/GHC/Tc/Gen/Bind.hs
=====================================
@@ -199,7 +199,7 @@ tcTopBinds binds sigs
           -- binders are unrestricted (and `tcSubmult _ ManyTy` returns the
           -- identity wrapper). Therefore it's safe to drop it altogether.
           --
-          -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+          -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
         ; specs <- tcImpPrags sigs   -- SPECIALISE prags for imported Ids
 
 
@@ -229,7 +229,7 @@ tcHsBootSigs binds sigs
 
 ------------------------
 
--- Why an HsWrapper? See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+-- Why an HsWrapper? See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
 tcLocalBinds :: HsLocalBinds GhcRn -> TcM thing
              -> TcM (HsLocalBinds GhcTc, HsWrapper, thing)
 
@@ -253,7 +253,7 @@ tcLocalBinds (HsIPBinds x (IPBinds _ ip_binds)) thing_inside
 
         -- We don't have linear implicit parameters, yet. So the wrapper can be
         -- the identity.
-        -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+        -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
         ; return (HsIPBinds x (IPBinds ev_binds ip_binds') , idHsWrapper, result) }
   where
     ips = [ip | (L _ (IPBind _ (L _ ip) _)) <- ip_binds]
@@ -280,7 +280,7 @@ tcLocalBinds (HsIPBinds x (IPBinds _ ip_binds)) thing_inside
     toDict ipClass x ty = mkHsWrap $ mkWpCastR $
                           wrapIP $ mkClassPred ipClass [x,ty]
 
--- Why an HsWrapper? See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+-- Why an HsWrapper? See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
 tcValBinds :: TopLevelFlag
            -> [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn]
            -> TcM thing
@@ -319,7 +319,7 @@ tcValBinds top_lvl binds sigs thing_inside
 
 ------------------------
 
--- Why an HsWrapper? See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+-- Why an HsWrapper? See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
 tcBindGroups :: TopLevelFlag -> TcSigFun -> TcPragEnv
              -> [(RecFlag, LHsBinds GhcRn)] -> TcM thing
              -> TcM ([(RecFlag, LHsBinds GhcTc)], HsWrapper, thing)
@@ -778,7 +778,7 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn bind_list
     manyIfPat (L loc pat@(PatBind {pat_mult=mult_ann, pat_lhs=lhs, pat_ext =(pat_ty,_)}))
       = do { mult_co_wrap <- tcSubMult (NonLinearPatternOrigin GeneralisedPatternReason nlWildPatName) ManyTy (getTcMultAnn mult_ann)
            -- The wrapper checks for correct multiplicities.
-           -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+           -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
            ; let lhs' = mkLHsWrapPat mult_co_wrap lhs pat_ty
            ; return $ L loc pat {pat_lhs=lhs'}
            }


=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -435,7 +435,7 @@ tcExpr (HsLet x binds expr) res_ty
   = do  { (binds', wrapper, expr') <- tcLocalBinds binds $
                                       tcMonoExpr expr res_ty
           -- The wrapper checks for correct multiplicities.
-          -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+          -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
         ; return (HsLet x binds' (mkLHsWrap wrapper expr')) }
 
 tcExpr (HsCase ctxt scrut matches) res_ty
@@ -1641,9 +1641,9 @@ tcRecordBinds
         -> HsRecordBinds GhcRn
         -> TcM (HsRecordBinds GhcTc)
 
-tcRecordBinds con_like arg_tys (HsRecFields rbinds dd)
+tcRecordBinds con_like arg_tys (HsRecFields _ rbinds dd)
   = do  { mb_binds <- mapM do_bind rbinds
-        ; return (HsRecFields (catMaybes mb_binds) dd) }
+        ; return (HsRecFields [] (catMaybes mb_binds) dd) }
   where
     fields = map flSelector $ conLikeFieldLabels con_like
     flds_w_tys = zipEqual "tcRecordBinds" fields arg_tys


=====================================
compiler/GHC/Tc/Gen/Pat.hs
=====================================
@@ -103,7 +103,7 @@ tcLetPat sig_fn no_gen pat pat_ty thing_inside
        ; dflags <- getDynFlags
        ; mult_co_wrap <- manyIfLazy dflags pat
        -- The wrapper checks for correct multiplicities.
-       -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+       -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
        ; (pat', r) <- tc_lpat pat_ty penv pat thing_inside
        ; pat_ty' <- readExpType (scaledThing pat_ty)
        ; return (mkLHsWrapPat mult_co_wrap pat' pat_ty', r) }
@@ -468,7 +468,7 @@ tc_lpats tys penv pats
                (zipEqual "tc_lpats" pats tys)
 
 --------------------
--- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+-- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
 checkManyPattern :: NonLinearPatternReason -> LPat GhcRn -> Scaled a -> TcM HsWrapper
 checkManyPattern reason pat pat_ty = tcSubMult (NonLinearPatternOrigin reason pat) ManyTy (scaledMult pat_ty)
 
@@ -627,7 +627,7 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
         { (wrap, id) <- tcPatBndr penv name pat_ty
         ; (res, mult_wrap) <- tcCheckUsage name (scaledMult pat_ty) $
                               tcExtendIdEnv1 name id thing_inside
-            -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+            -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
         ; pat_ty <- readExpType (scaledThing pat_ty)
         ; return (mkHsWrapPat (wrap <.> mult_wrap) (VarPat x (L l id)) pat_ty, res) }
 
@@ -651,7 +651,7 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
 
   LazyPat x pat -> do
         { mult_wrap <- checkManyPattern LazyPatternReason (noLocA ps_pat) pat_ty
-            -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+            -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
         ; (pat', (res, pat_ct))
                 <- tc_lpat pat_ty (makeLazy penv) pat $
                    captureConstraints thing_inside
@@ -669,14 +669,14 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
 
   WildPat _ -> do
         { mult_wrap <- checkManyPattern OtherPatternReason (noLocA ps_pat) pat_ty
-            -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+            -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
         ; res <- thing_inside
         ; pat_ty <- expTypeToType (scaledThing pat_ty)
         ; return (mkHsWrapPat mult_wrap (WildPat pat_ty) pat_ty, res) }
 
   AsPat x (L nm_loc name) pat -> do
         { mult_wrap <- checkManyPattern OtherPatternReason (noLocA ps_pat) pat_ty
-            -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+            -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
         ; (wrap, bndr_id) <- setSrcSpanA nm_loc (tcPatBndr penv name pat_ty)
         ; (pat', res) <- tcExtendIdEnv1 name bndr_id $
                          tc_lpat (pat_ty `scaledSet`(mkCheckExpType $ idType bndr_id))
@@ -693,7 +693,7 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
 
   ViewPat _ expr pat -> do
         { mult_wrap <- checkManyPattern ViewPatternReason (noLocA ps_pat) pat_ty
-         -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+         -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
          --
          -- It should be possible to have view patterns at linear (or otherwise
          -- non-Many) multiplicity. But it is not clear at the moment what
@@ -859,7 +859,7 @@ Fortunately that's what matchActualFunTy returns anyway.
 -- When there is no negation, neg_lit_ty and lit_ty are the same
   NPat _ (L l over_lit) mb_neg eq -> do
         { mult_wrap <- checkManyPattern OtherPatternReason (noLocA ps_pat) pat_ty
-          -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+          -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
           --
           -- It may be possible to refine linear pattern so that they work in
           -- linear environments. But it is not clear how useful this is.
@@ -912,7 +912,7 @@ AST is used for the subtraction operation.
   NPlusKPat _ (L nm_loc name)
                (L loc lit) _ ge minus -> do
         { mult_wrap <- checkManyPattern OtherPatternReason (noLocA ps_pat) pat_ty
-            -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+            -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
         ; let pat_exp_ty = scaledThing pat_ty
               orig = LiteralOrigin lit
         ; (lit1', ge')
@@ -1296,7 +1296,7 @@ tcPatSynPat (L con_span con_name) pat_syn pat_ty penv arg_pats thing_inside
         ; when (any isEqPred prov_theta) warnMonoLocalBinds
 
         ; mult_wrap <- checkManyPattern PatternSynonymReason nlWildPatName pat_ty
-            -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
+            -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
 
         ; (univ_ty_args, ex_ty_args) <- splitConTyArgs con_like arg_pats
 
@@ -1587,6 +1587,28 @@ However there are several quite tricky wrinkles.
      enough.  See #22328 for the story.
 -}
 
+{- Note [Omitted record fields and linearity]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+
+  data T = MkT {a:A, b:B}
+  f :: T -> A
+  f (MkT{a=a}) = a
+
+The pattern in f is equivalent to
+
+  f (MkT a _) = a
+
+Evidently, the b field isn't used linearly here, it must be typed as a wildcard
+pattern. However, this is *the only check* for omitted record fields: if it
+weren't for linearity checking, the type checker could ignore b altogether. So
+we have a function check_omitted_fields_multiplicity, whose purpose is to do the
+linearity checking on the omitted fields.
+
+check_omitted_fields_multiplicity returns coercions which all need to be
+reflexivity after zonking: see Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
+-}
+
 tcConValArgs :: ConLike
              -> [Scaled TcSigmaTypeFRR]
              -> Checker (HsConPatDetails GhcRn) (HsConPatDetails GhcTc)
@@ -1615,9 +1637,11 @@ tcConValArgs con_like arg_tys penv con_args thing_inside = case con_args of
     where
       con_arity  = conLikeArity con_like
 
-  RecCon (HsRecFields rpats dd) -> do
-        { (rpats', res) <- tcMultiple tc_field penv rpats thing_inside
-        ; return (RecCon (HsRecFields rpats' dd), res) }
+  RecCon (HsRecFields _ rpats dd) -> do
+        { mult_cos <- check_omitted_fields_multiplicity
+           -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
+        ; (rpats', res) <- tcMultiple tc_field penv rpats thing_inside
+        ; return ((RecCon (HsRecFields mult_cos rpats' dd)), res) }
     where
       tc_field :: Checker (LHsRecField GhcRn (LPat GhcRn))
                           (LHsRecField GhcTc (LPat GhcTc))
@@ -1630,11 +1654,16 @@ tcConValArgs con_like arg_tys penv con_args thing_inside = case con_args of
              ; (pat', res) <- tcConArg penv (pat, pat_ty) thing_inside
              ; return (L l (HsFieldBind ann (L loc (FieldOcc sel' (L lr rdr))) pat'
                                                                         pun), res) }
-
+      -- See Note [Omitted record fields and linearity]
+      check_omitted_fields_multiplicity :: TcM MultiplicityCheckCoercions
+      check_omitted_fields_multiplicity = do
+        mult_coss <- forM omitted_field_tys $ \(fl, pat_ty) ->
+          tcSubMult' (OmittedFieldOrigin fl) ManyTy (scaledMult pat_ty)
+        return $ concat mult_coss
 
       find_field_ty :: Name -> FastString -> TcM (Scaled TcType)
       find_field_ty sel lbl
-        = case [ty | (fl, ty) <- field_tys, flSelector fl == sel ] of
+        = case [ty | (Just fl, ty) <- bound_field_tys, flSelector fl == sel ] of
 
                 -- No matching field; chances are this field label comes from some
                 -- other record type (or maybe none).  If this happens, just fail,
@@ -1649,11 +1678,22 @@ tcConValArgs con_like arg_tys penv con_args thing_inside = case con_args of
                 traceTc "find_field" (ppr pat_ty <+> ppr extras)
                 assert (null extras) (return pat_ty)
 
-      field_tys :: [(FieldLabel, Scaled TcType)]
-      field_tys = zip (conLikeFieldLabels con_like) arg_tys
-          -- Don't use zipEqual! If the constructor isn't really a record, then
-          -- dataConFieldLabels will be empty (and each field in the pattern
-          -- will generate an error below).
+      bound_field_tys, omitted_field_tys :: [(Maybe FieldLabel, Scaled TcType)]
+      (bound_field_tys, omitted_field_tys) = partition is_bound all_field_tys
+
+      is_bound :: (Maybe FieldLabel, Scaled TcType) -> Bool
+      is_bound (Just fl, _) = elem (flSelector fl) (map (\(L _ (HsFieldBind _ (L _ (FieldOcc sel _ )) _ _)) -> sel) rpats)
+      is_bound _ = False
+
+      all_field_tys :: [(Maybe FieldLabel, Scaled TcType)]
+      all_field_tys = zip con_field_labels arg_tys
+          -- If the constructor isn't really a record, then dataConFieldLabels
+          -- will be empty (and each field in the pattern will generate an error
+          -- below). We still need those unnamed fields for
+          -- linearity-checking. Hence we zip the anonymous fields with Nothing.
+
+      con_field_labels :: [Maybe FieldLabel]
+      con_field_labels = (map Just (conLikeFieldLabels con_like)) ++ repeat Nothing
 
 
 splitConTyArgs :: ConLike -> HsConPatDetails GhcRn


=====================================
compiler/GHC/Tc/TyCl/PatSyn.hs
=====================================
@@ -1010,9 +1010,9 @@ tcPatToExpr args pat = go pat
 
     mkRecordConExpr :: LocatedN Name -> HsRecFields GhcRn (LPat GhcRn)
                     -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
-    mkRecordConExpr con (HsRecFields fields dd)
+    mkRecordConExpr con (HsRecFields x fields dd)
       = do { exprFields <- mapM go' fields
-           ; return (RecordCon noExtField con (HsRecFields exprFields dd)) }
+           ; return (RecordCon noExtField con (HsRecFields x exprFields dd)) }
 
     go' :: LHsRecField GhcRn (LPat GhcRn) -> Either PatSynInvalidRhsReason (LHsRecField GhcRn (LHsExpr GhcRn))
     go' (L l rf) = L l <$> traverse go rf


=====================================
compiler/GHC/Tc/TyCl/Utils.hs
=====================================
@@ -942,7 +942,7 @@ mkOneRecordSelector all_cons idDetails fl has_sel
                                  (L (l2l loc') [L loc' (mk_sel_pat con)])
                                  (L loc' (HsVar noExtField (L locn field_var)))
     mk_sel_pat con = ConPat NoExtField (L locn (getName con)) (RecCon rec_fields)
-    rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing }
+    rec_fields = HsRecFields { rec_ext = noExtField, rec_flds = [rec_field], rec_dotdot = Nothing }
     rec_field  = noLocA (HsFieldBind
                         { hfbAnn = noAnn
                         , hfbLHS


=====================================
compiler/GHC/Tc/Types/Evidence.hs
=====================================
@@ -39,7 +39,7 @@ module GHC.Tc.Types.Evidence (
 
   -- * TcCoercion
   TcCoercion, TcCoercionR, TcCoercionN, TcCoercionP, CoercionHole,
-  TcMCoercion, TcMCoercionN, TcMCoercionR,
+  TcMCoercion, TcMCoercionN, TcMCoercionR, MultiplicityCheckCoercions,
   Role(..), LeftOrRight(..), pickLR,
   maybeSymCo,
   unwrapIP, wrapIP,
@@ -110,6 +110,11 @@ type TcMCoercion  = MCoercion
 type TcMCoercionN = MCoercionN  -- nominal
 type TcMCoercionR = MCoercionR  -- representational
 
+type MultiplicityCheckCoercions = [TcCoercion]
+-- Coercions which must all be reflexivity after zonking.
+-- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify.
+
+
 -- | If a 'SwapFlag' is 'IsSwapped', flip the orientation of a coercion
 maybeSymCo :: SwapFlag -> TcCoercion -> TcCoercion
 maybeSymCo IsSwapped  co = mkSymCo co
@@ -174,7 +179,7 @@ data HsWrapper
 
   | WpMultCoercion Coercion     -- Require that a Coercion be reflexive; otherwise,
                                 -- error in the desugarer. See GHC.Tc.Utils.Unify
-                                -- Note [Wrapper returned from tcSubMult]
+                                -- Note [Coercions returned from tcSubMult]
   deriving Data.Data
 
 -- | The Semigroup instance is a bit fishy, since @WpCompose@, as a data


=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -623,6 +623,7 @@ data CtOrigin
       ClsInst -- ^ The declared typeclass instance
 
   | NonLinearPatternOrigin NonLinearPatternReason (LPat GhcRn)
+  | OmittedFieldOrigin (Maybe FieldLabel)
   | UsageEnvironmentOf Name
 
   | CycleBreakerOrigin
@@ -936,6 +937,8 @@ pprCtO ListOrigin            = text "an overloaded list"
 pprCtO IfThenElseOrigin      = text "an if-then-else expression"
 pprCtO StaticOrigin          = text "a static form"
 pprCtO (UsageEnvironmentOf x) = hsep [text "multiplicity of", quotes (ppr x)]
+pprCtO (OmittedFieldOrigin Nothing) = text "an omitted anonymous field"
+pprCtO (OmittedFieldOrigin (Just fl)) = hsep [text "omitted field" <+> quotes (ppr fl)]
 pprCtO BracketOrigin         = text "a quotation bracket"
 
 -- These ones are handled by pprCtOrigin, but we nevertheless sometimes


=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -2275,7 +2275,7 @@ a \/\a in the final result but all the occurrences of a will be zonked to ()
 
 -- | @tcCheckUsage name mult thing_inside@ runs @thing_inside@, checks that the
 -- usage of @name@ is a submultiplicity of @mult@, and removes @name@ from the
--- usage environment. See also Note [Wrapper returned from tcSubMult] in
+-- usage environment. See also Note [Coercions returned from tcSubMult] in
 -- GHC.Tc.Utils.Unify, which applies to the wrapper returned from this function.
 tcCheckUsage :: Name -> Mult -> TcM a -> TcM (a, HsWrapper)
 tcCheckUsage name id_mult thing_inside


=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -14,7 +14,7 @@ module GHC.Tc.Utils.Unify (
   -- Full-blown subsumption
   tcWrapResult, tcWrapResultO, tcWrapResultMono,
   tcSubType, tcSubTypeSigma, tcSubTypePat, tcSubTypeDS,
-  tcSubTypeAmbiguity, tcSubMult,
+  tcSubTypeAmbiguity, tcSubMult, tcSubMult',
   checkConstraints, checkTvConstraints,
   buildImplicationFor, buildTvImplication, emitResidualTvConstraint,
 
@@ -1539,22 +1539,33 @@ message) is very conservative:
                           where type instance F [x] t = t
 
 
-Note [Wrapper returned from tcSubMult]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-There is no notion of multiplicity coercion in Core, therefore the wrapper
-returned by tcSubMult (and derived functions such as tcCheckUsage and
-checkManyPattern) is quite unlike any other wrapper: it checks whether the
-coercion produced by the constraint solver is trivial, producing a type error
-if it is not. This is implemented via the WpMultCoercion wrapper, as desugared
-by GHC.HsToCore.Binds.dsHsWrapper, which does the reflexivity check.
+Note [Coercions returned from tcSubMult]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+At the moment, we insist that all sub-multiplicity tests turn out
+(once the typechecker has finished its work) to be equalities,
+i.e. implementable by ReflCo.  Why?  Because our type system has
+no way to express non-Refl sub-multiplicities.
+
+How can we check that every call to `tcSubMult` returns `Refl`?
+It might not be `Refl` *yet*.
+
+[TODO: add counterexample #25130]
 
-This wrapper needs to be placed in the term; otherwise, checking of the
-eventual coercion won't be triggered during desugaring. But it can be put
-anywhere, since it doesn't affect the desugared code.
+So we take a two-stage approach:
+* Generate a coercion now, and hang it in the HsSyn syntax tree
+* In the desugarer, after zonking, check that it is Refl.
 
-Why do we check this in the desugarer? It's a convenient place, since it's
-right after all the constraints are solved. We need the constraints to be
-solved to check whether they are trivial or not.
+We "hang it in the tree" in two different ways:
+A) In a HsWrapper, in the WpMultCoercion alternative. The
+   desugarer checks that WpMultCoercions are Refl, and then
+   discards them.  See `GHC.HsToCore.Binds.dsHsWrapper`
+B) In an extension field.  For example, in the extension
+   field of `HsRecFields`.  See `check_omitted_fields_multiplicity`
+   in `GHC.Tc.Gen.Pat.tcDataConPat`
+
+The former mechanism (A) seemed convenient at the time, but has
+turned out to add a lot of friction, so we plan to move towards
+(B): see #25128
 
 An alternative would be to have a kind of constraint which can
 only produce trivial evidence. This would allow such checks to happen
@@ -1562,30 +1573,39 @@ in the constraint solver (#18756).
 This would be similar to the existing setup for Concrete, see
   Note [The Concrete mechanism] in GHC.Tc.Utils.Concrete
     (PHASE 1 in particular).
+
 -}
 
 tcSubMult :: CtOrigin -> Mult -> Mult -> TcM HsWrapper
-tcSubMult origin w_actual w_expected
+tcSubMult' :: CtOrigin -> Mult -> Mult -> TcM MultiplicityCheckCoercions
+tcSubMult origin w_actual w_expected =
+  do { mult_cos <- tcSubMult' origin w_actual w_expected
+     ; return (foldMap WpMultCoercion mult_cos) }
+tcSubMult' origin w_actual w_expected
   | Just (w1, w2) <- isMultMul w_actual =
-  do { w1 <- tcSubMult origin w1 w_expected
-     ; w2 <- tcSubMult origin w2 w_expected
-     ; return (w1 <.> w2) }
+  do { w1 <- tcSubMult' origin w1 w_expected
+     ; w2 <- tcSubMult' origin w2 w_expected
+     ; return (w1 ++ w2) }
   -- Currently, we consider p*q and sup p q to be equal.  Therefore, p*q <= r is
   -- equivalent to p <= r and q <= r.  For other cases, we approximate p <= q by p
   -- ~ q.  This is not complete, but it's sound. See also Note [Overapproximating
   -- multiplicities] in Multiplicity.
-tcSubMult origin w_actual w_expected =
+tcSubMult' origin w_actual w_expected =
   case submult w_actual w_expected of
-    Submult -> return WpHole
-    Unknown -> tcEqMult origin w_actual w_expected
+    Submult -> return []
+    Unknown -> tcEqMult' origin w_actual w_expected
 
 tcEqMult :: CtOrigin -> Mult -> Mult -> TcM HsWrapper
-tcEqMult origin w_actual w_expected = do
+tcEqMult' :: CtOrigin -> Mult -> Mult -> TcM MultiplicityCheckCoercions
+tcEqMult origin w_actual w_expected =
+  do { mult_cos <- tcEqMult' origin w_actual w_expected
+     ; return (foldMap WpMultCoercion mult_cos) }
+tcEqMult' origin w_actual w_expected = do
   {
   -- Note that here we do not call to `submult`, so we check
   -- for strict equality.
   ; coercion <- unifyTypeAndEmit TypeLevel origin w_actual w_expected
-  ; return $ if isReflCo coercion then WpHole else WpMultCoercion coercion }
+  ; return $ if isReflCo coercion then [] else [coercion] }
 
 
 {- *********************************************************************


=====================================
compiler/GHC/Tc/Zonk/Type.hs
=====================================
@@ -1462,9 +1462,9 @@ zonkStmt _zBody (XStmtLR (ApplicativeStmt body_ty args mb_join))
 
 -------------------------------------------------------------------------
 zonkRecFields :: HsRecordBinds GhcTc -> ZonkTcM (HsRecordBinds GhcTc)
-zonkRecFields (HsRecFields flds dd)
+zonkRecFields (HsRecFields x flds dd)
   = do  { flds' <- mapM zonk_rbind flds
-        ; return (HsRecFields flds' dd) }
+        ; return (HsRecFields x flds' dd) }
   where
     zonk_rbind (L l fld)
       = do { new_id   <- wrapLocZonkMA zonkFieldOcc (hfbLHS fld)
@@ -1629,12 +1629,13 @@ zonkConStuff (InfixCon p1 p2)
         ; p2' <- zonkPat p2
         ; return (InfixCon p1' p2') }
 
-zonkConStuff (RecCon (HsRecFields rpats dd))
+zonkConStuff (RecCon (HsRecFields x rpats dd))
   = do  { pats' <- zonkPats (map (hfbRHS . unLoc) rpats)
+        ; x' <- mapM (noBinders . zonkCoToCo) x
         ; let rpats' = zipWith (\(L l rp) p' ->
                                   L l (rp { hfbRHS = p' }))
                                rpats pats'
-        ; return (RecCon (HsRecFields rpats' dd)) }
+        ; return (RecCon (HsRecFields x' rpats' dd)) }
         -- Field selectors have declared types; hence no zonking
 
 ---------------------------


=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -1156,7 +1156,7 @@ cvtl e = wrapLA (cvt e)
                               ; return $ ExprWithTySig noAnn pe (mkHsWildCardBndrs t') }
     cvt (RecConE c flds) = do { c' <- cNameN c
                               ; flds' <- mapM (cvtFld (wrapParLA mkFieldOcc)) flds
-                              ; return $ mkRdrRecordCon c' (HsRecFields flds' Nothing) noAnn }
+                              ; return $ mkRdrRecordCon c' (HsRecFields noExtField flds' Nothing) noAnn }
     cvt (RecUpdE e flds) = do { e' <- cvtl e
                               ; flds'
                                   <- mapM (cvtFld (wrapParLA mkAmbiguousFieldOcc))
@@ -1506,7 +1506,7 @@ cvtp (RecP c fs)       = do { c' <- cNameN c; fs' <- mapM cvtPatFld fs
                             ; return $ ConPat
                                 { pat_con_ext = noAnn
                                 , pat_con = c'
-                                , pat_args = Hs.RecCon $ HsRecFields fs' Nothing
+                                , pat_args = Hs.RecCon $ HsRecFields noExtField fs' Nothing
                                 }
                             }
 cvtp (ListP ps)        = do { ps' <- cvtPats ps


=====================================
compiler/Language/Haskell/Syntax/Pat.hs
=====================================
@@ -25,7 +25,7 @@ module Language.Haskell.Syntax.Pat (
 
         HsConPatDetails, hsConPatArgs, hsConPatTyArgs,
         HsConPatTyArg(..), XConPatTyArg,
-        HsRecFields(..), HsFieldBind(..), LHsFieldBind,
+        HsRecFields(..), XHsRecFields, HsFieldBind(..), LHsFieldBind,
         HsRecField, LHsRecField,
         HsRecUpdField, LHsRecUpdField,
         RecFieldsDotDot(..),
@@ -287,11 +287,14 @@ hsConPatTyArgs (InfixCon _ _)       = []
 data HsRecFields p arg         -- A bunch of record fields
                                 --      { x = 3, y = True }
         -- Used for both expressions and patterns
-  = HsRecFields { rec_flds   :: [LHsRecField p arg],
+  = HsRecFields { rec_ext    :: !(XHsRecFields p),
+                  rec_flds   :: [LHsRecField p arg],
                   rec_dotdot :: Maybe (XRec p RecFieldsDotDot) }  -- Note [DotDot fields]
   -- AZ:The XRec for LHsRecField makes the derivings fail.
   -- deriving (Functor, Foldable, Traversable)
 
+type family XHsRecFields p
+
 -- | Newtype to be able to have a specific XRec instance for the Int in `rec_dotdot`
 newtype RecFieldsDotDot = RecFieldsDotDot { unRecFieldsDotDot :: Int }
     deriving (Data, Eq, Ord)


=====================================
testsuite/tests/linear/should_compile/OmitFieldPat.hs
=====================================
@@ -0,0 +1,15 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LinearTypes #-}
+
+module OmitFieldPat where
+
+import GHC.Types
+
+-- This tests that we are indeed allowed to drop fields of multiplicity Many. At
+-- time of writing this test, there is no syntax for non-linear fields in
+-- record. Instead use a regular constructor and the empty record pattern.
+data T where
+  MkT :: Int %Many -> Bool %Many -> T
+
+good :: T %1 -> ()
+good (MkT{}) = ()


=====================================
testsuite/tests/linear/should_compile/all.T
=====================================
@@ -46,3 +46,4 @@ test('T23814', normal, compile, [''])
 test('LinearLet', normal, compile, [''])
 test('LinearLetPoly', normal, compile, [''])
 test('LinearListComprehension', normal, compile, ['-dlinear-core-lint'])
+test('OmitFieldPat', normal, compile, ['-dcore-lint'])


=====================================
testsuite/tests/linear/should_fail/T24961.hs
=====================================
@@ -0,0 +1,18 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LinearTypes #-}
+
+module T24961 where
+
+import GHC.Types
+
+data R = MkR { a::Int, b::Bool }
+
+-- Tests the that named dropped linear fields are rejected
+bad_named :: R %1 -> Int
+bad_named (MkR{a=x}) = x
+
+-- Tests that linear unnamed fields in a `{}` pattern are rejected.
+data T = MkT Int Bool
+
+bad_anonymous :: T %1 -> ()
+bad_anonymous (MkT{}) = ()


=====================================
testsuite/tests/linear/should_fail/T24961.stderr
=====================================
@@ -0,0 +1,12 @@
+T24961.hs:12:12: error: [GHC-18872]
+    • Couldn't match type ‘Many’ with ‘One’
+        arising from omitted field ‘b’
+    • In the pattern: MkR {a = x}
+      In an equation for ‘bad_named’: bad_named (MkR {a = x}) = x
+
+T24961.hs:18:16: error: [GHC-18872]
+    • Couldn't match type ‘Many’ with ‘One’
+        arising from an omitted anonymous field
+    • In the pattern: MkT {}
+      In an equation for ‘bad_anonymous’: bad_anonymous (MkT {}) = ()
+


=====================================
testsuite/tests/linear/should_fail/all.T
=====================================
@@ -52,3 +52,4 @@ test('LinearLet8', normal, compile_fail, [''])
 test('LinearLet9', normal, compile_fail, [''])
 test('LinearLet10', normal, compile_fail, [''])
 test('T25081', normal, compile_fail, [''])
+test('T24961', normal, compile_fail, [''])


=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -3350,7 +3350,7 @@ instance ExactPrint (MatchGroup GhcPs (LocatedA (HsCmd GhcPs))) where
 instance (ExactPrint body) => ExactPrint (HsRecFields GhcPs body) where
   getAnnotationEntry = const NoEntryVal
   setAnnotationAnchor a _ _ _ = a
-  exact (HsRecFields fields mdot) = do
+  exact (HsRecFields x fields mdot) = do
     fields' <- markAnnotated fields
     mdot' <- case mdot of
       Nothing -> return Nothing
@@ -3358,7 +3358,7 @@ instance (ExactPrint body) => ExactPrint (HsRecFields GhcPs body) where
         ss' <- printStringAtAA ss ".."
         return $ Just (L ss' d)
       -- Note: mdot contains the SrcSpan where the ".." appears, if present
-    return (HsRecFields fields' mdot')
+    return (HsRecFields x fields' mdot')
 
 -- ---------------------------------------------------------------------
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ae4b76a741f63186a39bd07e60373ec46aec7ff...623b4337001506aacd917702aec3d3d386c70ad8

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ae4b76a741f63186a39bd07e60373ec46aec7ff...623b4337001506aacd917702aec3d3d386c70ad8
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/20240813/74ab9a84/attachment-0001.html>


More information about the ghc-commits mailing list