GHC proposal 496 - Nullary record wildcards

This patch implements GHC proposal 496, which allows record wildcards
to be used for nullary constructors, e.g.

  data A = MkA1 | MkA2 { fld1 :: Int }
  f :: A -> Int
  f (MkA1 {..}) = 0
  f (MkA2 {..}) = fld1

To achieve this, we add arity information to the record field
environment, so that we can accept a constructor which has no fields
while continuing to reject non-record constructors with more than 1
field. See Note [Nullary constructors and empty record wildcards],
as well as the more general overview in Note [Local constructor info in the renamer],
both in the newly introduced GHC.Types.ConInfo module.

Fixes #22161

32 files changed, 335 insertions, 73 deletions

diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index ec423d0087..830e1a0dcc 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -36,7 +36,7 @@ module GHC.Rename.Env (
         lookupSigCtxtOccRn, lookupSigCtxtOccRnN,
 
         lookupInstDeclBndr, lookupFamInstName,
-        lookupConstructorFields,
+        lookupConstructorInfo, lookupConstructorFields,
 
         lookupGreAvailRn,
 
@@ -105,6 +105,7 @@ import GHC.Types.FieldLabel
 import GHC.Data.Bag
 import GHC.Types.PkgQual
 import Language.Haskell.Syntax.Basic (FieldLabelString(..))
+import GHC.Types.ConInfo (ConInfo, conInfoFields, mkConInfo)
 
 {-
 *********************************************************
@@ -399,27 +400,34 @@ lookupFamInstName (Just cls) tc_rdr  -- Associated type; c.f GHC.Rename.Bind.rnM
 lookupFamInstName Nothing tc_rdr     -- Family instance; tc_rdr is an *occurrence*
   = lookupLocatedOccRnConstr tc_rdr
 
------------------------------------------------
-lookupConstructorFields :: Name -> RnM [FieldLabel]
--- Look up the fields of a given constructor
+lookupConstructorInfo :: Name -> RnM ConInfo
+-- Look up the info for a given constructor
 --   *  For constructors from this module, use the record field env,
 --      which is itself gathered from the (as yet un-typechecked)
 --      data type decls
+--      For more details, see Note [Local constructor info in the renamer]
 --
 --    * For constructors from imported modules, use the *type* environment
 --      since imported modules are already compiled, the info is conveniently
 --      right there
 
-lookupConstructorFields con_name
+lookupConstructorInfo con_name
   = do  { this_mod <- getModule
         ; if nameIsLocalOrFrom this_mod con_name then
-          do { field_env <- getRecFieldEnv
-             ; traceTc "lookupCF" (ppr con_name $$ ppr (lookupNameEnv field_env con_name) $$ ppr field_env)
-             ; return (lookupNameEnv field_env con_name `orElse` []) }
+          do { con_env <- getConEnv
+             ; let conInfo = lookupNameEnv con_env con_name
+             ; traceTc "lookupCF" (ppr con_name $$ ppr conInfo $$ ppr con_env)
+             -- we always info for all the constructors in the current module in GHC.Rename.mk_con_env
+             -- hence we should be able to look up the constructor in tcg_con_env if it's from the current module
+             ; return (conInfo `orElse` panic "GHC.Rename.Env.lookupConstructorInfo") }
           else
           do { con <- tcLookupConLike con_name
              ; traceTc "lookupCF 2" (ppr con)
-             ; return (conLikeFieldLabels con) } }
+             ; pure $ mkConInfo (conLikeArity con) (conLikeFieldLabels con) } }
+
+-----------------------------------------------
+lookupConstructorFields :: Name -> RnM [FieldLabel]
+lookupConstructorFields = fmap conInfoFields . lookupConstructorInfo
 
 
 -- In CPS style as `RnM r` is monadic
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index fd9792744c..29a12299c4 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -1,5 +1,6 @@
 
 {-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies        #-}
 
@@ -79,6 +80,7 @@ import Data.List.NonEmpty ( NonEmpty(..), head )
 import Data.Maybe ( isNothing, fromMaybe, mapMaybe )
 import qualified Data.Set as Set ( difference, fromList, toList, null )
 import Data.Function ( on )
+import GHC.Types.ConInfo (ConInfo, mkConInfo, conInfoFields)
 
 {- | @rnSourceDecl@ "renames" declarations.
 It simultaneously performs dependency analysis and precedence parsing.
@@ -2646,23 +2648,23 @@ extendPatSynEnv :: DuplicateRecordFields -> FieldSelectors -> HsValBinds GhcPs -
                 -> ([Name] -> TcRnIf TcGblEnv TcLclEnv a) -> TcM a
 extendPatSynEnv dup_fields_ok has_sel val_decls local_fix_env thing = do {
      names_with_fls <- new_ps val_decls
-   ; let pat_syn_bndrs = concat [ name: map flSelector fields
+   ; let pat_syn_bndrs = concat [ name : map flSelector (conInfoFields fields)
                                 | (name, fields) <- names_with_fls ]
    ; let avails = map avail (map fst names_with_fls)
-               ++ map availField (concatMap snd names_with_fls)
+               ++ map availField (concatMap (conInfoFields  . snd) names_with_fls)
    ; (gbl_env, lcl_env) <- extendGlobalRdrEnvRn avails local_fix_env
 
-   ; let field_env' = extendNameEnvList (tcg_field_env gbl_env) names_with_fls
-         final_gbl_env = gbl_env { tcg_field_env = field_env' }
+   ; let field_env' = extendNameEnvList (tcg_con_env gbl_env) names_with_fls
+         final_gbl_env = gbl_env { tcg_con_env = field_env' }
    ; restoreEnvs (final_gbl_env, lcl_env) (thing pat_syn_bndrs) }
   where
-    new_ps :: HsValBinds GhcPs -> TcM [(Name, [FieldLabel])]
+    new_ps :: HsValBinds GhcPs -> TcM [(Name, ConInfo)]
     new_ps (ValBinds _ binds _) = foldrM new_ps' [] binds
     new_ps _ = panic "new_ps"
 
     new_ps' :: LHsBindLR GhcPs GhcPs
-            -> [(Name, [FieldLabel])]
-            -> TcM [(Name, [FieldLabel])]
+            -> [(Name, ConInfo)]
+            -> TcM [(Name, ConInfo)]
     new_ps' bind names
       | (L bind_loc (PatSynBind _ (PSB { psb_id = L _ n
                                        , psb_args = RecCon as }))) <- bind
@@ -2670,11 +2672,20 @@ extendPatSynEnv dup_fields_ok has_sel val_decls local_fix_env thing = do {
           bnd_name <- newTopSrcBinder (L (l2l bind_loc) n)
           let field_occs = map ((\ f -> L (noAnnSrcSpan $ getLocA (foLabel f)) f) . recordPatSynField) as
           flds <- mapM (newRecordSelector dup_fields_ok has_sel [bnd_name]) field_occs
-          return ((bnd_name, flds): names)
-      | L bind_loc (PatSynBind _ (PSB { psb_id = L _ n})) <- bind
+          let conInfo =
+                mkConInfo
+                  (conDetailsArity length (RecCon as))
+                  flds
+          return ((bnd_name, conInfo): names)
+      | L bind_loc (PatSynBind _ (PSB { psb_id = L _ n
+                                      , psb_args})) <- bind
       = do
         bnd_name <- newTopSrcBinder (L (la2na bind_loc) n)
-        return ((bnd_name, []): names)
+        let conInfo =
+              mkConInfo
+                (conDetailsArity length psb_args)
+                []
+        return ((bnd_name, conInfo): names)
       | otherwise
       = return names
 
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 7cd47c724b..65bb2c92d2 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -64,12 +64,13 @@ import GHC.Types.Avail
 import GHC.Types.FieldLabel
 import GHC.Types.SourceFile
 import GHC.Types.SrcLoc as SrcLoc
-import GHC.Types.Basic  ( TopLevelFlag(..) )
+import GHC.Types.Basic  ( Arity, TopLevelFlag(..) )
 import GHC.Types.SourceText
 import GHC.Types.Id
 import GHC.Types.HpcInfo
 import GHC.Types.Error
 import GHC.Types.PkgQual
+import GHC.Types.ConInfo (ConInfo, mkConInfo)
 
 import GHC.Unit
 import GHC.Unit.Module.Warnings
@@ -95,6 +96,7 @@ import qualified Data.List.NonEmpty as NE
 import Data.Function    ( on )
 import qualified Data.Set as S
 import Data.Foldable    ( toList )
+import Data.Void        ( Void )
 import System.FilePath  ((</>))
 
 import System.IO
@@ -936,11 +938,11 @@ getLocalNonValBinders fixity_env
 
         -- Force the field access so that tcg_env is not retained. The
         -- selector thunk optimisation doesn't kick-in, see #20139
-        ; let !old_field_env = tcg_field_env tcg_env
-        -- Extend tcg_field_env with new fields (this used to be the
+        ; let !old_field_env = tcg_con_env tcg_env
+        -- Extend tcg_con_env with new fields (this used to be the
         -- work of extendRecordFieldEnv)
               field_env = extendNameEnvList old_field_env flds
-              envs      = (tcg_env { tcg_field_env = field_env }, tcl_env)
+              envs      = (tcg_env { tcg_con_env = field_env }, tcl_env)
 
         ; traceRn "getLocalNonValBinders 3" (vcat [ppr flds, ppr field_env])
         ; return (envs, new_bndrs) } }
@@ -955,39 +957,75 @@ getLocalNonValBinders fixity_env
                             ; return (avail nm) }
 
     new_tc :: DuplicateRecordFields -> FieldSelectors -> LTyClDecl GhcPs
-           -> RnM (AvailInfo, [(Name, [FieldLabel])])
+           -> RnM (AvailInfo, [(Name, ConInfo)])
     new_tc dup_fields_ok has_sel tc_decl -- NOT for type/data instances
         = do { let (bndrs, flds) = hsLTyClDeclBinders tc_decl
              ; names@(main_name : sub_names) <- mapM (newTopSrcBinder . l2n) bndrs
              ; flds' <- mapM (newRecordSelector dup_fields_ok has_sel sub_names) flds
              ; let fld_env = case unLoc tc_decl of
-                     DataDecl { tcdDataDefn = d } -> mk_fld_env d names flds'
+                     DataDecl { tcdDataDefn = d } -> mk_con_env d names flds'
                      _                            -> []
              ; return (availTC main_name names flds', fld_env) }
 
 
-    -- Calculate the mapping from constructor names to fields, which
-    -- will go in tcg_field_env. It's convenient to do this here where
+    -- Calculate the mapping from constructor names to arity and fields, which
+    -- will go in tcg_con_env. It's convenient to do this here where
     -- we are working with a single datatype definition.
-    mk_fld_env :: HsDataDefn GhcPs -> [Name] -> [FieldLabel]
-               -> [(Name, [FieldLabel])]
-    mk_fld_env d names flds = concatMap find_con_flds (dd_cons d)
+    -- For more details, see Note [Local constructor info in the renamer]
+    mk_con_env :: HsDataDefn GhcPs -> [Name] -> [FieldLabel]
+               -> [(Name, ConInfo)]
+    mk_con_env d names flds = concatMap find_con_flds (dd_cons d)
       where
+        find_con_flds :: GenLocated l (ConDecl GhcPs) -> [(Name, ConInfo)]
         find_con_flds (L _ (ConDeclH98 { con_name = L _ rdr
-                                       , con_args = RecCon cdflds }))
+                                       , con_args = con_det }))
             = [( find_con_name rdr
-               , concatMap find_con_decl_flds (unLoc cdflds) )]
+               , con_det_con_info con_det
+               )]
         find_con_flds (L _ (ConDeclGADT { con_names = rdrs
-                                        , con_g_args = RecConGADT flds _ }))
+                                        , con_g_args = con_gadt_det }))
             = [ ( find_con_name rdr
-                 , concatMap find_con_decl_flds (unLoc flds))
+                , gadt_det_con_info con_gadt_det
+                )
               | L _ rdr <- toList rdrs ]
 
-        find_con_flds _ = []
-
         find_con_name rdr
           = expectJust "getLocalNonValBinders/find_con_name" $
               find (\ n -> nameOccName n == rdrNameOcc rdr) names
+
+        con_det_con_info
+          :: HsConDetails Void (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)])
+          -> ConInfo
+        con_det_con_info con_det =
+          let
+            (arity, fields) =
+              case con_det of
+                PrefixCon _ args ->
+                  (length args, [])
+                RecCon cdflds ->
+                  ((find_con_decl_field_arity . unLoc) cdflds, concatMap find_con_decl_flds $ unLoc cdflds)
+                InfixCon _ _ ->
+                  (2, [])
+           in
+            mkConInfo
+              arity
+              fields
+
+        gadt_det_con_info :: HsConDeclGADTDetails GhcPs -> ConInfo
+        gadt_det_con_info con_gadt_det =
+          let
+            (arity, fields) =
+              case con_gadt_det of
+                PrefixConGADT args ->
+                  (length args, [])
+                RecConGADT (L _ args) _ ->
+                  (find_con_decl_field_arity args, concatMap find_con_decl_flds args)
+           in
+            mkConInfo
+              arity
+              fields
+
+        find_con_decl_flds :: GenLocated l (ConDeclField GhcPs) -> [FieldLabel]
         find_con_decl_flds (L _ x)
           = map find_con_decl_fld (cd_fld_names x)
 
@@ -996,14 +1034,17 @@ getLocalNonValBinders fixity_env
               find (\ fl -> flLabel fl == lbl) flds
           where lbl = FieldLabelString $ occNameFS (rdrNameOcc rdr)
 
+        find_con_decl_field_arity :: [GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> Arity
+        find_con_decl_field_arity = length . concatMap (cd_fld_names . unLoc)
+
     new_assoc :: DuplicateRecordFields -> FieldSelectors -> LInstDecl GhcPs
-              -> RnM ([AvailInfo], [(Name, [FieldLabel])])
+              -> RnM ([AvailInfo], [(Name, ConInfo)])
     new_assoc _ _ (L _ (TyFamInstD {})) = return ([], [])
       -- type instances don't bind new names
 
     new_assoc dup_fields_ok has_sel (L _ (DataFamInstD _ d))
-      = do { (avail, flds) <- new_di dup_fields_ok has_sel Nothing d
-           ; return ([avail], flds) }
+      = do { (avail, arityAndFlds) <- new_di dup_fields_ok has_sel Nothing d
+           ; return ([avail], arityAndFlds) }
     new_assoc dup_fields_ok has_sel (L _ (ClsInstD _ (ClsInstDecl { cid_poly_ty = inst_ty
                                                       , cid_datafam_insts = adts })))
       = do -- First, attempt to grab the name of the class from the instance.
@@ -1032,7 +1073,7 @@ getLocalNonValBinders fixity_env
                pure (avails, concat fldss)
 
     new_di :: DuplicateRecordFields -> FieldSelectors -> Maybe Name -> DataFamInstDecl GhcPs
-                   -> RnM (AvailInfo, [(Name, [FieldLabel])])
+                   -> RnM (AvailInfo, [(Name, ConInfo)])
     new_di dup_fields_ok has_sel mb_cls dfid@(DataFamInstDecl { dfid_eqn = ti_decl })
         = do { main_name <- lookupFamInstName mb_cls (feqn_tycon ti_decl)
              ; let (bndrs, flds) = hsDataFamInstBinders dfid
@@ -1040,11 +1081,11 @@ getLocalNonValBinders fixity_env
              ; flds' <- mapM (newRecordSelector dup_fields_ok has_sel sub_names) flds
              ; let avail    = availTC (unLoc main_name) sub_names flds'
                                   -- main_name is not bound here!
-                   fld_env  = mk_fld_env (feqn_rhs ti_decl) sub_names flds'
+                   fld_env  = mk_con_env (feqn_rhs ti_decl) sub_names flds'
              ; return (avail, fld_env) }
 
     new_loc_di :: DuplicateRecordFields -> FieldSelectors -> Maybe Name -> LDataFamInstDecl GhcPs
-                   -> RnM (AvailInfo, [(Name, [FieldLabel])])
+                   -> RnM (AvailInfo, [(Name, ConInfo)])
     new_loc_di dup_fields_ok has_sel mb_cls (L _ d) = new_di dup_fields_ok has_sel mb_cls d
 
 newRecordSelector :: DuplicateRecordFields -> FieldSelectors -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index 169c2e508c..ccfb77fbde 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -82,6 +82,7 @@ import Data.Maybe
 import Data.Ratio
 import GHC.Types.FieldLabel (DuplicateRecordFields(..))
 import Language.Haskell.Syntax.Basic (FieldLabelString(..))
+import GHC.Types.ConInfo (ConInfo(..), conInfoFields)
 
 {-
 *********************************************************
@@ -809,8 +810,8 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
         do { dd_flag <- xoptM LangExt.RecordWildCards
            ; checkErr dd_flag (needFlagDotDot ctxt)
            ; (rdr_env, lcl_env) <- getRdrEnvs
-           ; con_fields <- lookupConstructorFields con
-           ; when (null con_fields) (addErr (TcRnIllegalWildcardsInConstructor con))
+           ; conInfo <- lookupConstructorInfo con
+           ; when (conInfo == ConHasPositionalArgs) (addErr (TcRnIllegalWildcardsInConstructor con))
            ; let present_flds = mkOccSet $ map rdrNameOcc (getFieldLbls flds)
 
                    -- For constructor uses (but not patterns)
@@ -822,7 +823,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
 
                  (dot_dot_fields, dot_dot_gres)
                         = unzip [ (fl, gre)
-                                | fl <- con_fields
+                                | fl <- conInfoFields conInfo
                                 , let lbl = mkVarOccFS (field_label $ flLabel fl)
                                 , not (lbl `elemOccSet` present_flds)
                                 , Just gre <- [lookupGRE_FieldLabel rdr_env fl]
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 02acd47e2e..017b29425c 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -251,8 +251,10 @@ instance Diagnostic TcRnMessage where
       -> mkSimpleDecorated $ text "character literal out of range: '\\" <> char c  <> char '\''
     TcRnIllegalWildcardsInConstructor con
       -> mkSimpleDecorated $
-           vcat [ text "Illegal `..' notation for constructor" <+> quotes (ppr con)
-                , nest 2 (text "The constructor has no labelled fields") ]
+           vcat [ text "Illegal `{..}' notation for constructor" <+> quotes (ppr con)
+                , nest 2 (text "Record wildcards may not be used for constructors with unlabelled fields.")
+                , nest 2 (text "Possible fix: Remove the `{..}' and add a match for each field of the constructor.")
+                ]
     TcRnIgnoringAnnotations anns
       -> mkSimpleDecorated $
            text "Ignoring ANN annotation" <> plural anns <> comma
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 0420a4e498..108eba5ab0 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -591,7 +591,11 @@ data TcRnMessage where
 
       Examples(s): None
 
-     Test cases: None
+     Test cases:
+       rename/should_fail/T9815.hs
+       rename/should_fail/T9815b.hs
+       rename/should_fail/T9815ghci.hs
+       rename/should_fail/T9815bghci.hs
   -}
   TcRnIllegalWildcardsInConstructor :: !Name -> TcRnMessage
 
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index edfa5a9258..f877e006b8 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -157,6 +157,7 @@ import GHC.Types.SrcLoc
 import GHC.Types.SourceFile
 import GHC.Types.TyThing.Ppr ( pprTyThingInContext )
 import GHC.Types.PkgQual
+import GHC.Types.ConInfo (mkConInfo)
 import qualified GHC.LanguageExtensions as LangExt
 
 import GHC.Unit.External
@@ -2099,8 +2100,8 @@ runTcInteractive hsc_env thing_inside
                                                (extendFamInstEnvList (tcg_fam_inst_env gbl_env)
                                                                      ic_finsts)
                                                home_fam_insts
-                                    , tcg_field_env    = mkNameEnv con_fields
-                                         -- setting tcg_field_env is necessary
+                                    , tcg_con_env    = mkNameEnv con_fields
+                                         -- setting tcg_con_env is necessary
                                          -- to make RecordWildCards work (test: ghci049)
                                     , tcg_fix_env      = ic_fix_env icxt
                                     , tcg_default      = ic_default icxt
@@ -2135,7 +2136,7 @@ runTcInteractive hsc_env thing_inside
                 -- Putting the dfuns in the type_env
                 -- is just to keep Core Lint happy
 
-    con_fields = [ (dataConName c, dataConFieldLabels c)
+    con_fields = [ (dataConName c, mkConInfo (dataConSourceArity c) (dataConFieldLabels c))
                  | ATyCon t <- top_ty_things
                  , c <- tyConDataCons t ]
 
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs
index 5625bad539..acf7a0e6af 100644
--- a/compiler/GHC/Tc/Types.hs
+++ b/compiler/GHC/Tc/Types.hs
@@ -40,7 +40,7 @@ module GHC.Tc.Types(
         FrontendResult(..),
 
         -- Renamer types
-        ErrCtxt, RecFieldEnv, pushErrCtxt, pushErrCtxtSameOrigin,
+        ErrCtxt, pushErrCtxt, pushErrCtxtSameOrigin,
         ImportAvails(..), emptyImportAvails, plusImportAvails,
         WhereFrom(..), mkModDeps,
 
@@ -126,7 +126,6 @@ import GHC.Core.FamInstEnv
 import GHC.Core.Predicate
 
 import GHC.Types.Id         ( idType, idName )
-import GHC.Types.FieldLabel ( FieldLabel )
 import GHC.Types.Fixity.Env
 import GHC.Types.Annotations
 import GHC.Types.CompleteMatch
@@ -146,6 +145,7 @@ import GHC.Types.Unique.FM
 import GHC.Types.Basic
 import GHC.Types.CostCentre.State
 import GHC.Types.HpcInfo
+import GHC.Types.ConInfo (ConFieldEnv)
 
 import GHC.Data.IOEnv
 import GHC.Data.Bag
@@ -167,8 +167,8 @@ import GHC.Builtin.Names ( isUnboundName )
 
 import Data.Set      ( Set )
 import qualified Data.Set as S
-import Data.Map ( Map )
 import Data.Dynamic  ( Dynamic )
+import Data.Map ( Map )
 import Data.Typeable ( TypeRep )
 import Data.Maybe    ( mapMaybe )
 import GHCi.Message
@@ -443,8 +443,10 @@ data TcGblEnv
           -- ^ Types used for defaulting. @Nothing@ => no @default@ decl
 
         tcg_fix_env   :: FixityEnv,     -- ^ Just for things in this module
-        tcg_field_env :: RecFieldEnv,   -- ^ Just for things in this module
-                                        -- See Note [The interactive package] in "GHC.Runtime.Context"
+        tcg_con_env :: ConFieldEnv,
+          -- ^ Just for things in this module
+          -- For information on why this is necessary, see Note [Local constructor info in the renamer]
+          -- See Note [The interactive package] in "GHC.Runtime.Context"
 
         tcg_type_env :: TypeEnv,
           -- ^ Global type env for the module we are compiling now.  All
@@ -687,15 +689,6 @@ tcVisibleOrphanMods tcg_env
 instance ContainsModule TcGblEnv where
     extractModule env = tcg_semantic_mod env
 
-type RecFieldEnv = NameEnv [FieldLabel]
-        -- Maps a constructor name *in this module*
-        -- to the fields for that constructor.
-        -- This is used when dealing with ".." notation in record
-        -- construction and pattern matching.
-        -- The FieldEnv deals *only* with constructors defined in *this*
-        -- module.  For imported modules, we get the same info from the
-        -- TypeEnv
-
 data SelfBootInfo
   = NoSelfBoot    -- No corresponding hi-boot file
   | SelfBoot
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index ecd3ab3249..a8ab977def 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -55,7 +55,7 @@ module GHC.Tc.Utils.Monad(
   getIsGHCi, getGHCiMonad, getInteractivePrintName,
   tcIsHsBootOrSig, tcIsHsig, tcSelfBootInfo, getGlobalRdrEnv,
   getRdrEnvs, getImports,
-  getFixityEnv, extendFixityEnv, getRecFieldEnv,
+  getFixityEnv, extendFixityEnv, getConEnv,
   getDeclaredDefaultTys,
   addDependentFiles,
 
@@ -209,6 +209,7 @@ import GHC.Types.Annotations
 import GHC.Types.Basic( TopLevelFlag, TypeOrKind(..) )
 import GHC.Types.CostCentre.State
 import GHC.Types.SourceFile
+import GHC.Types.ConInfo (ConFieldEnv)
 
 import qualified GHC.LanguageExtensions as LangExt
 
@@ -300,7 +301,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
                 tcg_src            = hsc_src,
                 tcg_rdr_env        = emptyGlobalRdrEnv,
                 tcg_fix_env        = emptyNameEnv,
-                tcg_field_env      = emptyNameEnv,
+                tcg_con_env        = emptyNameEnv,
                 tcg_default        = if moduleUnit mod == primUnit
                                      || moduleUnit mod == bignumUnit
                                      then Just []  -- See Note [Default types]
@@ -942,8 +943,8 @@ extendFixityEnv new_bit
   = updGblEnv (\env@(TcGblEnv { tcg_fix_env = old_fix_env }) ->
                 env {tcg_fix_env = extendNameEnvList old_fix_env new_bit})
 
-getRecFieldEnv :: TcRn RecFieldEnv
-getRecFieldEnv = do { env <- getGblEnv; return (tcg_field_env env) }
+getConEnv :: TcRn ConFieldEnv
+getConEnv = do { env <- getGblEnv; return (tcg_con_env env) }
 
 getDeclaredDefaultTys :: TcRn (Maybe [Type])
 getDeclaredDefaultTys = do { env <- getGblEnv; return (tcg_default env) }
diff --git a/compiler/GHC/Types/ConInfo.hs b/compiler/GHC/Types/ConInfo.hs
new file mode 100644
index 0000000000..b89ce2632d
--- /dev/null
+++ b/compiler/GHC/Types/ConInfo.hs
@@ -0,0 +1,82 @@
+{-# LANGUAGE DerivingStrategies #-}
+module GHC.Types.ConInfo (
+  ConFieldEnv, ConInfo(..), mkConInfo, conInfoFields,
+  ) where
+
+import GHC.Prelude
+import GHC.Types.Name.Env (NameEnv)
+import Data.List.NonEmpty (NonEmpty)
+import GHC.Types.FieldLabel ( FieldLabel )
+import qualified Data.List.NonEmpty as NonEmpty
+import GHC.Types.Basic (Arity)
+import GHC.Utils.Outputable (Outputable(..), text, (<+>), equals, braces, (<>))
+
+{- Note [Local constructor info in the renamer]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+During renaming, we need certain information about constructors.
+
+While we can use TypeEnv to get this info for constructors from imported modules,
+the same cannot be done for constructors defined in the module
+that we are currently renaming, as they have not been type checked yet.
+
+Hence, we use ConFieldEnv to store the minimal information required to proceed
+with renaming, getting it from the parse tree.
+
+For example, consider
+  data T = T1 { x, y :: Int }
+         | T2 { x :: Int }
+         | T3
+         | T4 Int Bool
+
+Specifically we need to know:
+* The fields of the data constructor, so that
+  - We can complain if you say `T1 { v = 3 }`, where `v` is not a field of `T1`
+    See the following call stack
+    * GHC.Rename.Expr.rnExpr (RecordCon case)
+    * GHC.Rename.Pat.rnHsRecFields
+    * GHC.Rename.Env.lookupRecFieldOcc
+  - Ditto if you pattern match on `T1 { v = x }`.
+    See the following call stack
+    * GHC.Rename.Pat.rnHsRecPatsAndThen
+    * GHC.Rename.Pat.rnHsRecFields
+    * GHC.Rename.Env.lookupRecFieldOcc
+  - We can fill in the dots if you say `T1 {..}` in construction or pattern matching
+    See GHC.Rename.Pat.rnHsRecFields.rn_dotdot
+
+* Whether the contructor is nullary.
+  We need to know this to accept `T2 {..}`, and `T3 {..}`, but reject `T4 {..}`,
+  in both construction and pattern matching.
+  See GHC.Rename.Pat.rnHsRecFields.rn_dotdot
+  and Note [Nullary constructors and empty record wildcards]
+
+Note [Nullary constructors and empty record wildcards]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A nullary constructor is one with no arguments.
+For example, both `data T = MkT` and `data T = MkT {}` are nullary.
+
+For consistency and TH convenience, it was agreed that a `{..}`
+match or usage on nullary constructors would be accepted.
+This is done as as per https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0496-empty-record-wildcards.rst
+-}
+type ConFieldEnv = NameEnv ConInfo
+
+-- | See Note [Local constructor info in the renamer]
+data ConInfo
+  = ConHasRecordFields (NonEmpty FieldLabel)
+  | ConHasPositionalArgs
+  | ConIsNullary
+  deriving stock Eq
+
+mkConInfo :: Arity -> [FieldLabel] -> ConInfo
+mkConInfo 0 _ = ConIsNullary
+mkConInfo _ fields = maybe ConHasPositionalArgs ConHasRecordFields $ NonEmpty.nonEmpty fields
+
+conInfoFields :: ConInfo -> [FieldLabel]
+conInfoFields (ConHasRecordFields fields) = NonEmpty.toList fields
+conInfoFields ConHasPositionalArgs = []
+conInfoFields ConIsNullary = []
+
+instance Outputable ConInfo where
+  ppr ConIsNullary = text "ConIsNullary"
+  ppr ConHasPositionalArgs = text "ConHasPositionalArgs"
+  ppr (ConHasRecordFields fieldLabels) = text "ConHasRecordFields" <> braces (text "fieldLabels" <+> equals <+> ppr fieldLabels)
diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs
index 8898d2400b..fa57f9d2ef 100644
--- a/compiler/Language/Haskell/Syntax/Type.hs
+++ b/compiler/Language/Haskell/Syntax/Type.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
+{-# LANGUAGE LambdaCase #-}
                                       -- in module Language.Haskell.Syntax.Extension
 {-
 (c) The University of Glasgow 2006
@@ -44,7 +45,7 @@ module Language.Haskell.Syntax.Type (
 
         ConDeclField(..), LConDeclField,
 
-        HsConDetails(..), noTypeArgs,
+        HsConDetails(..), noTypeArgs, conDetailsArity,
 
         FieldOcc(..), LFieldOcc,
         AmbiguousFieldOcc(..), LAmbiguousFieldOcc,
@@ -64,6 +65,7 @@ import GHC.Types.Name.Reader ( RdrName )
 import GHC.Core.DataCon( HsSrcBang(..) )
 import GHC.Core.Type (Specificity)
 import GHC.Types.SrcLoc (SrcSpan)
+import GHC.Types.Basic (Arity)
 
 import GHC.Hs.Doc (LHsDoc)
 import GHC.Data.FastString (FastString)
@@ -74,7 +76,7 @@ import Data.Maybe
 import Data.Eq
 import Data.Bool
 import Data.Char
-import Prelude (Integer)
+import Prelude (Integer, length)
 
 {-
 ************************************************************************
@@ -1072,6 +1074,12 @@ data HsConDetails tyarg arg rec
 noTypeArgs :: [Void]
 noTypeArgs = []
 
+conDetailsArity :: (rec -> Arity) -> HsConDetails tyarg arg rec -> Arity
+conDetailsArity recToArity = \case
+  PrefixCon _ args -> length args
+  RecCon rec -> recToArity rec
+  InfixCon _ _ -> 2
+
 {-
 Note [ConDeclField pass]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index cb3d82e591..74384caf49 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -751,6 +751,7 @@ Library
         GHC.Types.Basic
         GHC.Types.BreakInfo
         GHC.Types.CompleteMatch
+        GHC.Types.ConInfo
         GHC.Types.CostCentre
         GHC.Types.CostCentre.State
         GHC.Types.Cpr
diff --git a/docs/users_guide/9.8.1-notes.rst b/docs/users_guide/9.8.1-notes.rst
index f836f62320..503105472e 100644
--- a/docs/users_guide/9.8.1-notes.rst
+++ b/docs/users_guide/9.8.1-notes.rst
@@ -21,6 +21,12 @@ Compiler
 
       foo (\x -> x*2 + x)
 
+- GHC Proposal `#496
+  <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0496-empty-record-wildcards.rst>`_
+  has been implemented, allowing ``{..}`` syntax for constructors without fields, for consistency.
+  This is convenient for TH code generation, as you can now uniformly use record wildcards
+  regardless of number of fields.
+
 GHCi
 ~~~~
 
diff --git a/testsuite/tests/count-deps/CountDepsAst.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout
index cdc15da1ca..efd58af99f 100644
--- a/testsuite/tests/count-deps/CountDepsAst.stdout
+++ b/testsuite/tests/count-deps/CountDepsAst.stdout
@@ -201,6 +201,7 @@ GHC.Types.Avail
 GHC.Types.Basic
 GHC.Types.BreakInfo
 GHC.Types.CompleteMatch
+GHC.Types.ConInfo
 GHC.Types.CostCentre
 GHC.Types.CostCentre.State
 GHC.Types.Cpr
diff --git a/testsuite/tests/count-deps/CountDepsParser.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout
index 8256bb8add..f1116f5198 100644
--- a/testsuite/tests/count-deps/CountDepsParser.stdout
+++ b/testsuite/tests/count-deps/CountDepsParser.stdout
@@ -208,6 +208,7 @@ GHC.Types.Avail
 GHC.Types.Basic
 GHC.Types.BreakInfo
 GHC.Types.CompleteMatch
+GHC.Types.ConInfo
 GHC.Types.CostCentre
 GHC.Types.CostCentre.State
 GHC.Types.Cpr
diff --git a/testsuite/tests/rename/should_compile/GADTNullaryRecordRecordWildcard.hs b/testsuite/tests/rename/should_compile/GADTNullaryRecordRecordWildcard.hs
new file mode 100644
index 0000000000..0c706d1209
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/GADTNullaryRecordRecordWildcard.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE GADTSyntax #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module GADTNullaryRecordRecordWildcard where
+
+data X a where
+  X :: {} -> X a
+
+f X {..} = ()
diff --git a/testsuite/tests/rename/should_compile/GADTNullaryRecordWildcard.hs b/testsuite/tests/rename/should_compile/GADTNullaryRecordWildcard.hs
new file mode 100644
index 0000000000..1181427485
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/GADTNullaryRecordWildcard.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE GADTSyntax #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module GADTNullaryRecordWildcard where
+
+data X a where
+  X :: X a
+
+f X {..} = ()
diff --git a/testsuite/tests/rename/should_compile/GADTSymbolicRecordRecordWildcard.hs b/testsuite/tests/rename/should_compile/GADTSymbolicRecordRecordWildcard.hs
new file mode 100644
index 0000000000..f69d5a6aa2
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/GADTSymbolicRecordRecordWildcard.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE GADTSyntax #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module GADTSymbolicRecordRecordWildcard where
+
+data G a where
+  (:&) :: {fld1 :: Int, fld2 :: a} -> G a
+
+f :: G Int -> Int
+f (:&) {..} = fld1 + fld2
diff --git a/testsuite/tests/rename/should_compile/GHCIImplicitImportNullaryRecordWildcard.script b/testsuite/tests/rename/should_compile/GHCIImplicitImportNullaryRecordWildcard.script
new file mode 100644
index 0000000000..5e8740424b
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/GHCIImplicitImportNullaryRecordWildcard.script
@@ -0,0 +1,3 @@
+:set -XRecordWildCards
+
+f x = GHC.Generics.U1 {..}
diff --git a/testsuite/tests/rename/should_compile/GHCINullaryRecordWildcard.script b/testsuite/tests/rename/should_compile/GHCINullaryRecordWildcard.script
new file mode 100644
index 0000000000..56c6f062f1
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/GHCINullaryRecordWildcard.script
@@ -0,0 +1,5 @@
+:set -XRecordWildCards
+
+data Foo = Foo
+
+f Foo {..} = Foo {..}
diff --git a/testsuite/tests/rename/should_compile/ImportNullaryRecordWildcard.hs b/testsuite/tests/rename/should_compile/ImportNullaryRecordWildcard.hs
new file mode 100644
index 0000000000..0746eae29b
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/ImportNullaryRecordWildcard.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module ImportNullaryRecordWildcard where
+
+import NullaryRecordWildcard as A
+import NullaryRecordRecordWildcard as B
+
+g A.X {..} = ()
+
+h B.X {..} = ()
diff --git a/testsuite/tests/rename/should_compile/NullaryRecordRecordWildcard.hs b/testsuite/tests/rename/should_compile/NullaryRecordRecordWildcard.hs
new file mode 100644
index 0000000000..86fe464268
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/NullaryRecordRecordWildcard.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module NullaryRecordRecordWildcard where
+
+data X = X { }
+
+f X {..} = ()
diff --git a/testsuite/tests/rename/should_compile/NullaryRecordWildcard.hs b/testsuite/tests/rename/should_compile/NullaryRecordWildcard.hs
new file mode 100644
index 0000000000..ab3e3fbe7e
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/NullaryRecordWildcard.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module NullaryRecordWildcard where
+
+data X = X
+
+f X {..} = ()
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 673cdf8c78..ba05c88357 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -200,3 +200,11 @@ test('T22513g', normal, compile, ['-Wterm-variable-capture'])
 test('T22513h', normal, compile, ['-Wterm-variable-capture'])
 test('T22513i', req_th, compile, ['-Wterm-variable-capture'])
 test('T22913', normal, compile, [''])
+test('NullaryRecordWildcard', normal, compile, [''])
+test('GADTNullaryRecordWildcard', normal, compile, [''])
+test('NullaryRecordRecordWildcard', normal, compile, [''])
+test('GADTNullaryRecordRecordWildcard', normal, compile, [''])
+test('GADTSymbolicRecordRecordWildcard', normal, compile, [''])
+test('ImportNullaryRecordWildcard', [extra_files(['NullaryRecordWildcard.hs', 'NullaryRecordRecordWildcard.hs'])], multimod_compile, ['ImportNullaryRecordWildcard', '-v0'])
+test('GHCINullaryRecordWildcard', combined_output, ghci_script, ['GHCINullaryRecordWildcard.script'])
+test('GHCIImplicitImportNullaryRecordWildcard', combined_output, ghci_script, ['GHCIImplicitImportNullaryRecordWildcard.script'])
diff --git a/testsuite/tests/rename/should_fail/T9815.stderr b/testsuite/tests/rename/should_fail/T9815.stderr
index 77b02eff6f..4f19bd115f 100644
--- a/testsuite/tests/rename/should_fail/T9815.stderr
+++ b/testsuite/tests/rename/should_fail/T9815.stderr
@@ -1,4 +1,5 @@
 
 T9815.hs:6:13: error: [GHC-47217]
-    Illegal `..' notation for constructor ‘N’
-      The constructor has no labelled fields
+    Illegal `{..}' notation for constructor ‘N’
+      Record wildcards may not be used for constructors with unlabelled fields.
+      Possible fix: Remove the `{..}' and add a match for each field of the constructor.
diff --git a/testsuite/tests/rename/should_fail/T9815b.hs b/testsuite/tests/rename/should_fail/T9815b.hs
new file mode 100644
index 0000000000..a61c43303d
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9815b.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE RecordWildCards #-}
+module T9815b where
+
+import T9815
+
+bar = print N{..}
diff --git a/testsuite/tests/rename/should_fail/T9815b.stderr b/testsuite/tests/rename/should_fail/T9815b.stderr
new file mode 100644
index 0000000000..4f19bd115f
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9815b.stderr
@@ -0,0 +1,5 @@
+
+T9815.hs:6:13: error: [GHC-47217]
+    Illegal `{..}' notation for constructor ‘N’
+      Record wildcards may not be used for constructors with unlabelled fields.
+      Possible fix: Remove the `{..}' and add a match for each field of the constructor.
diff --git a/testsuite/tests/rename/should_fail/T9815bghci.script b/testsuite/tests/rename/should_fail/T9815bghci.script
new file mode 100644
index 0000000000..5a07f142d9
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9815bghci.script
@@ -0,0 +1,5 @@
+:set -XRecordWildCards
+
+data Arg = Arg () Bool
+
+f x = Arg {..}
diff --git a/testsuite/tests/rename/should_fail/T9815bghci.stderr b/testsuite/tests/rename/should_fail/T9815bghci.stderr
new file mode 100644
index 0000000000..9d267cf5fb
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9815bghci.stderr
@@ -0,0 +1,5 @@
+
+<interactive>:5:7: [GHC-47217]
+    Illegal `{..}' notation for constructor ‘Arg’
+      Record wildcards may not be used for constructors with unlabelled fields.
+      Possible fix: Remove the `{..}' and add a match for each field of the constructor.
diff --git a/testsuite/tests/rename/should_fail/T9815ghci.script b/testsuite/tests/rename/should_fail/T9815ghci.script
new file mode 100644
index 0000000000..3e748c76ae
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9815ghci.script
@@ -0,0 +1,3 @@
+:set -XRecordWildCards
+
+f x = Data.Semigroup.Arg {..}
diff --git a/testsuite/tests/rename/should_fail/T9815ghci.stderr b/testsuite/tests/rename/should_fail/T9815ghci.stderr
new file mode 100644
index 0000000000..c4f4a91d23
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9815ghci.stderr
@@ -0,0 +1,5 @@
+
+<interactive>:3:7: [GHC-47217]
+    Illegal `{..}' notation for constructor ‘Data.Semigroup.Arg’
+      Record wildcards may not be used for constructors with unlabelled fields.
+      Possible fix: Remove the `{..}' and add a match for each field of the constructor.
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index e15b13e9e3..6234f4a85d 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -110,6 +110,9 @@ test('T9436', normal, compile_fail, [''])
 test('T9437', normal, compile_fail, [''])
 test('T9077', normal, compile_fail, [''])
 test('T9815', normal, compile_fail, [''])
+test('T9815b', [extra_files(['T9815.hs'])], multimod_compile_fail, ['T9815b', '-v0'])
+test('T9815ghci', normal, ghci_script, ['T9815ghci.script'])
+test('T9815bghci', normal, ghci_script, ['T9815bghci.script'])
 
 test('T9032',
      normal,