Record dot syntaxwip/T18599

66 files changed, 1552 insertions, 75 deletions

diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 6f9aec86cb..93ea664739 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -332,6 +332,9 @@ basicKnownKeyNames
         fromListNName,
         toListName,
 
+        -- Overloaded record dot, record update
+        getFieldName, setFieldName,
+
         -- List operations
         concatName, filterName, mapName,
         zipName, foldrName, buildName, augmentName, appendName,
@@ -1527,6 +1530,11 @@ fromListName    = varQual gHC_EXTS (fsLit "fromList")  fromListClassOpKey
 fromListNName   = varQual gHC_EXTS (fsLit "fromListN") fromListNClassOpKey
 toListName      = varQual gHC_EXTS (fsLit "toList")    toListClassOpKey
 
+-- HasField class ops
+getFieldName, setFieldName :: Name
+getFieldName   = varQual gHC_RECORDS (fsLit "getField") getFieldClassOpKey
+setFieldName   = varQual gHC_RECORDS (fsLit "setField") setFieldClassOpKey
+
 -- Class Show
 showClassName :: Name
 showClassName   = clsQual gHC_SHOW (fsLit "Show")      showClassKey
@@ -2548,6 +2556,10 @@ unsafeEqualityProofIdKey, unsafeCoercePrimIdKey :: Unique
 unsafeEqualityProofIdKey = mkPreludeMiscIdUnique 570
 unsafeCoercePrimIdKey    = mkPreludeMiscIdUnique 571
 
+-- HasField class ops
+getFieldClassOpKey, setFieldClassOpKey :: Unique
+getFieldClassOpKey = mkPreludeMiscIdUnique 572
+setFieldClassOpKey = mkPreludeMiscIdUnique 573
 
 ------------------------------------------------------
 -- ghc-bignum uses 600-699 uniques
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index e0ef09eba8..3633edf48c 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -3554,6 +3554,8 @@ xFlagsDeps = [
   flagSpec "Rank2Types"                       LangExt.RankNTypes,
   flagSpec "RankNTypes"                       LangExt.RankNTypes,
   flagSpec "RebindableSyntax"                 LangExt.RebindableSyntax,
+  flagSpec "OverloadedRecordDot"              LangExt.OverloadedRecordDot,
+  flagSpec "OverloadedRecordUpdate"           LangExt.OverloadedRecordUpdate,
   depFlagSpec' "RecordPuns"                   LangExt.RecordPuns
     (deprecatedForExtension "NamedFieldPuns"),
   flagSpec "RecordWildCards"                  LangExt.RecordWildCards,
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index ab6ebadd06..42ae115dab 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -287,6 +287,18 @@ type instance XRecordUpd     GhcPs = NoExtField
 type instance XRecordUpd     GhcRn = NoExtField
 type instance XRecordUpd     GhcTc = RecordUpdTc
 
+type instance XGetField     GhcPs = NoExtField
+type instance XGetField     GhcRn = NoExtField
+type instance XGetField     GhcTc = Void
+-- HsGetField is eliminated by the renamer. See [Handling overloaded
+-- and rebindable constructs].
+
+type instance XProjection     GhcPs = NoExtField
+type instance XProjection     GhcRn = NoExtField
+type instance XProjection     GhcTc = Void
+-- HsProjection is eliminated by the renamer. See [Handling overloaded
+-- and rebindable constructs].
+
 type instance XExprWithTySig (GhcPass _) = NoExtField
 
 type instance XArithSeq      GhcPs = NoExtField
@@ -509,8 +521,15 @@ ppr_expr (RecordCon { rcon_con = con, rcon_flds = rbinds })
                GhcRn -> ppr con
                GhcTc -> ppr con
 
-ppr_expr (RecordUpd { rupd_expr = L _ aexp, rupd_flds = rbinds })
-  = hang (ppr aexp) 2 (braces (fsep (punctuate comma (map ppr rbinds))))
+ppr_expr (RecordUpd { rupd_expr = L _ aexp, rupd_flds = flds })
+  = case flds of
+      Left rbinds -> hang (ppr aexp) 2 (braces (fsep (punctuate comma (map ppr rbinds))))
+      Right pbinds -> hang (ppr aexp) 2 (braces (fsep (punctuate comma (map ppr pbinds))))
+
+ppr_expr (HsGetField { gf_expr = L _ fexp, gf_field = field })
+  = ppr fexp <> dot <> ppr field
+
+ppr_expr (HsProjection { proj_flds = flds }) = parens (hcat (punctuate dot (map ppr flds)))
 
 ppr_expr (ExprWithTySig _ expr sig)
   = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
@@ -655,6 +674,8 @@ hsExprNeedsParens p = go
     go (HsBinTick _ _ _ (L _ e))      = go e
     go (RecordCon{})                  = False
     go (HsRecFld{})                   = False
+    go (HsProjection{})               = True
+    go (HsGetField{})                 = False
     go (XExpr x)
       | GhcTc <- ghcPass @p
       = case x of
@@ -828,7 +849,47 @@ A general recipe to follow this approach for new constructs could go as follows:
     - the XExpr (HsExpanded ... ...) case in tcExpr already makes sure that we
       typecheck the desugared expression while reporting the original one in
       errors
+-}
 
+{- Note [Overview of record dot syntax]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+This is the note that explains all the moving parts for record dot
+syntax.
+
+The language extensions @OverloadedRecordDot@ and
+@OverloadedRecordUpdate@ (providing "record dot syntax") are
+implemented using the techniques of Note [Rebindable syntax and
+HsExpansion].
+
+When OverloadedRecordDot is enabled:
+- Field selection expressions
+  - e.g. foo.bar.baz
+  - Have abstract syntax HsGetField
+  - After renaming are XExpr (HsExpanded (HsGetField ...) (getField @"..."...)) expressions
+- Field selector expressions e.g. (.x.y)
+  - Have abstract syntax HsProjection
+  - After renaming are XExpr (HsExpanded (HsProjection ...) ((getField @"...") . (getField @"...") . ...) expressions
+
+When OverloadedRecordUpdate is enabled:
+- Record update expressions
+  - e.g. a{foo.bar=1, quux="corge", baz}
+  - Have abstract syntax RecordUpd
+    - With rupd_flds containting a Right
+    - See Note [RecordDotSyntax field updates] (in Language.Haskell.Syntax.Expr)
+  - After renaming are XExpr (HsExpanded (RecordUpd ...) (setField@"..." ...) expressions
+    - Note that this is true for all record updates even for those that do not involve '.'
+
+When OverloadedRecordDot is enabled and RebindableSyntax is not
+enabled the name 'getField' is resolved to GHC.Records.getField. When
+OverloadedRecordDot is enabled and RebindableSyntax is enabled the
+name 'getField' is whatever in-scope name that is.
+
+When OverloadedRecordUpd is enabled and RebindableSyntax is not
+enabled it is an error for now (temporary while we wait on native
+setField support; see
+https://gitlab.haskell.org/ghc/ghc/-/issues/16232). When
+OverloadedRecordUpd is enabled and RebindableSyntax is enabled the
+names 'getField' and 'setField' are whatever in-scope names they are.
 -}
 
 -- See Note [Rebindable syntax and HsExpansion] just above.
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 9aadaff9fd..3a8c106b90 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -595,10 +595,14 @@ addTickHsExpr expr@(RecordCon { rcon_flds = rec_binds })
   = do { rec_binds' <- addTickHsRecordBinds rec_binds
        ; return (expr { rcon_flds = rec_binds' }) }
 
-addTickHsExpr expr@(RecordUpd { rupd_expr = e, rupd_flds = flds })
+addTickHsExpr expr@(RecordUpd { rupd_expr = e, rupd_flds = Left flds })
   = do { e' <- addTickLHsExpr e
        ; flds' <- mapM addTickHsRecField flds
-       ; return (expr { rupd_expr = e', rupd_flds = flds' }) }
+       ; return (expr { rupd_expr = e', rupd_flds = Left flds' }) }
+addTickHsExpr expr@(RecordUpd { rupd_expr = e, rupd_flds = Right flds })
+  = do { e' <- addTickLHsExpr e
+       ; flds' <- mapM addTickHsRecField flds
+       ; return (expr { rupd_expr = e', rupd_flds = Right flds' }) }
 
 addTickHsExpr (ExprWithTySig x e ty) =
         liftM3 ExprWithTySig
@@ -627,6 +631,8 @@ addTickHsExpr e@(HsBracket     {})   = return e
 addTickHsExpr e@(HsTcBracketOut  {}) = return e
 addTickHsExpr e@(HsRnBracketOut  {}) = return e
 addTickHsExpr e@(HsSpliceE  {})      = return e
+addTickHsExpr e@(HsGetField {})      = return e
+addTickHsExpr e@(HsProjection {})    = return e
 addTickHsExpr (HsProc x pat cmdtop) =
         liftM2 (HsProc x)
                 (addTickLPat pat)
@@ -987,7 +993,6 @@ addTickHsRecField (L l (HsRecField id expr pun))
         = do { expr' <- addTickLHsExpr expr
              ; return (L l (HsRecField id expr' pun)) }
 
-
 addTickArithSeqInfo :: ArithSeqInfo GhcTc -> TM (ArithSeqInfo GhcTc)
 addTickArithSeqInfo (From e1) =
         liftM From
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 50d9594e3c..387963827e 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -276,6 +276,9 @@ dsExpr (ExprWithTySig _ e _)  = dsLExpr e
 dsExpr (HsConLikeOut _ con)   = dsConLike con
 dsExpr (HsIPVar {})           = panic "dsExpr: HsIPVar"
 
+dsExpr (HsGetField x _ _)     = absurd x
+dsExpr (HsProjection x _)     = absurd x
+
 dsExpr (HsLit _ lit)
   = do { warnAboutOverflowedLit lit
        ; dsLit (convertLit lit) }
@@ -603,7 +606,11 @@ we want, namely
 
 -}
 
-dsExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields
+dsExpr RecordUpd { rupd_flds = Right _} =
+  -- Not possible due to elimination in the renamer. See Note
+  -- [Handling overloaded and rebindable constructs]
+  panic "The impossible happened"
+dsExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = Left fields
                        , rupd_ext = RecordUpdTc
                            { rupd_cons = cons_to_upd
                            , rupd_in_tys = in_inst_tys
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index d3453fcd56..149c683d83 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1581,10 +1581,15 @@ repE (RecordCon { rcon_con = c, rcon_flds = flds })
  = do { x <- lookupLOcc c;
         fs <- repFields flds;
         repRecCon x fs }
-repE (RecordUpd { rupd_expr = e, rupd_flds = flds })
+repE (RecordUpd { rupd_expr = e, rupd_flds = Left flds })
  = do { x <- repLE e;
         fs <- repUpdFields flds;
         repRecUpd x fs }
+repE (RecordUpd { rupd_flds = Right _ })
+  = do
+      -- Not possible due to elimination in the renamer. See Note
+      -- [Handling overloaded and rebindable constructs]
+      panic "The impossible has happened!"
 
 repE (ExprWithTySig _ e wc_ty)
   = addSimpleTyVarBinds (get_scoped_tvs_from_sig sig_ty) $
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 3fe14085a9..4c75399ee0 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -1118,10 +1118,13 @@ instance HiePass p => ToHie (Located (HsExpr (GhcPass p))) where
           con_name = case hiePass @p of       -- Like ConPat
                        HieRn -> con
                        HieTc -> fmap conLikeName con
-      RecordUpd {rupd_expr = expr, rupd_flds = upds}->
+      RecordUpd {rupd_expr = expr, rupd_flds = Left upds}->
         [ toHie expr
         , toHie $ map (RC RecFieldAssign) upds
         ]
+      RecordUpd {rupd_expr = expr, rupd_flds = Right _}->
+        [ toHie expr
+        ]
       ExprWithTySig _ expr sig ->
         [ toHie expr
         , toHie $ TS (ResolvedScopes [mkLScope expr]) sig
@@ -1159,6 +1162,8 @@ instance HiePass p => ToHie (Located (HsExpr (GhcPass p))) where
       HsSpliceE _ x ->
         [ toHie $ L mspan x
         ]
+      HsGetField {} -> []
+      HsProjection {} -> []
       XExpr x
         | GhcTc <- ghcPass @p
         , WrapExpr (HsWrap w a) <- x
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index ff380f8c75..df581b1898 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -64,7 +64,7 @@ import GHC.Utils.Outputable
 import GHC.Utils.Misc          ( looksLikePackageName, fstOf3, sndOf3, thdOf3 )
 
 import GHC.Types.Name.Reader
-import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, occNameFS )
+import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, occNameFS, mkVarOcc, occNameString)
 import GHC.Types.SrcLoc
 import GHC.Types.Basic
 import GHC.Types.Fixity
@@ -658,6 +658,8 @@ are the most common patterns, rewritten as regular expressions for clarity:
  '-<<'          { L _ (ITLarrowtail _) }            -- for arrow notation
  '>>-'          { L _ (ITRarrowtail _) }            -- for arrow notation
  '.'            { L _ ITdot }
+ PREFIX_PROJ    { L _ (ITproj True) }               -- RecordDotSyntax
+ TIGHT_INFIX_PROJ { L _ (ITproj False) }            -- RecordDotSyntax
  PREFIX_AT      { L _ ITtypeApp }
  PREFIX_PERCENT { L _ ITpercent }                   -- for linear types
 
@@ -2737,6 +2739,22 @@ fexp    :: { ECP }
                                         fmap ecpFromExp $
                                         ams (sLL $1 $> $ HsStatic noExtField $2)
                                             [mj AnnStatic $1] }
+
+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
+        | fexp TIGHT_INFIX_PROJ field
+            {% runPV (unECP $1) >>= \ $1 ->
+               -- Suppose lhs is an application term e.g. 'f a'
+               -- and rhs is '.b'. Usually we want the parse 'f
+               -- (a.b)' rather than '(f a).b.'. However, if lhs
+               -- is a projection 'r.a' (say) then we want the
+               -- parse '(r.a).b'.
+               fmap ecpFromExp $ ams (case $1 of
+                   L _ (HsApp _ f arg) | not $ isGetField f ->
+                     let l = comb2 arg $3 in
+                     L (getLoc f `combineSrcSpans` l)
+                       (HsApp noExtField f (mkRdrGetField l arg $3))
+                   _ -> mkRdrGetField (comb2 $1 $>) $1 $3) [mj AnnDot $2] }
+
         | aexp                       { $1 }
 
 aexp    :: { ECP }
@@ -2826,10 +2844,12 @@ aexp    :: { ECP }
 
 aexp1   :: { ECP }
         : aexp1 '{' fbinds '}' { ECP $
-                                  unECP $1 >>= \ $1 ->
-                                  $3 >>= \ $3 ->
-                                  amms (mkHsRecordPV (comb2 $1 $>) (comb2 $2 $4) $1 (snd $3))
-                                       (moc $2:mcc $4:(fst $3)) }
+                                   getBit OverloadedRecordUpdateBit >>= \ overloaded ->
+                                   unECP $1 >>= \ $1 ->
+                                   $3 >>= \ $3 ->
+                                   amms (mkHsRecordPV overloaded (comb2 $1 $>) (comb2 $2 $4) $1 (snd $3))
+                                        (moc $2:mcc $4:(fst $3))
+                               }
         | aexp2                { $1 }
 
 aexp2   :: { ECP }
@@ -2858,6 +2878,14 @@ aexp2   :: { ECP }
                                            amms (mkSumOrTuplePV (comb2 $1 $>) Boxed (snd $2))
                                                 ((mop $1:fst $2) ++ [mcp $3]) }
 
+        -- This case is only possible when 'OverloadedRecordDotBit' is enabled.
+        | '(' projection ')'            { ECP $
+                                            let (loc, (anns, fIELDS)) = $2
+                                                span = combineSrcSpans (combineSrcSpans (getLoc $1) loc) (getLoc $3)
+                                                expr = mkRdrProjection span (reverse fIELDS)
+                                            in amms (ecpFromExp' expr) ([mop $1] ++ reverse anns ++ [mcp $3])
+                                        }
+
         | '(#' texp '#)'                { ECP $
                                            unECP $2 >>= \ $2 ->
                                            amms (mkSumOrTuplePV (comb2 $1 $>) Unboxed (Tuple [L (gl $2) (Just $2)]))
@@ -2907,6 +2935,14 @@ aexp2   :: { ECP }
                                                           Nothing (reverse $3))
                                          [mu AnnOpenB $1,mu AnnCloseB $4] }
 
+projection :: { (SrcSpan, ([AddAnn], [Located FastString])) }
+projection
+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer
+        : projection TIGHT_INFIX_PROJ field
+             { let (loc, (anns, fs)) = $1 in
+               (combineSrcSpans (combineSrcSpans loc (gl $2)) (gl $3), (mj AnnDot $2 : anns, $3 : fs)) }
+        | PREFIX_PROJ field { (comb2 $1 $2, ([mj AnnDot $1], [$2])) }
+
 splice_exp :: { LHsExpr GhcPs }
         : splice_untyped { mapLoc (HsSpliceE noExtField) $1 }
         | splice_typed   { mapLoc (HsSpliceE noExtField) $1 }
@@ -3323,33 +3359,65 @@ qual  :: { forall b. DisambECP b => PV (LStmt GhcPs (Located b)) }
 -----------------------------------------------------------------------------
 -- Record Field Update/Construction
 
-fbinds  :: { forall b. DisambECP b => PV ([AddAnn],([LHsRecField GhcPs (Located b)], Maybe SrcSpan)) }
+fbinds  :: { forall b. DisambECP b => PV ([AddAnn],([Fbind b], Maybe SrcSpan)) }
         : fbinds1                       { $1 }
         | {- empty -}                   { return ([],([], Nothing)) }
 
-fbinds1 :: { forall b. DisambECP b => PV ([AddAnn],([LHsRecField GhcPs (Located b)], Maybe SrcSpan)) }
+fbinds1 :: { forall b. DisambECP b => PV ([AddAnn],([Fbind b], Maybe SrcSpan)) }
         : fbind ',' fbinds1
                  { $1 >>= \ $1 ->
                    $3 >>= \ $3 ->
-                   addAnnotation (gl $1) AnnComma (gl $2) >>
+                   let gl' = \case { Left (L l _) -> l;  Right (L l _) -> l } in
+                   addAnnotation (gl' $1) AnnComma (gl $2) >>
                    return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) }
         | fbind                         { $1 >>= \ $1 ->
                                           return ([],([$1], Nothing)) }
         | '..'                          { return ([mj AnnDotdot $1],([],   Just (getLoc $1))) }
 
-fbind   :: { forall b. DisambECP b => PV (LHsRecField GhcPs (Located b)) }
+fbind   :: { forall b. DisambECP b => PV (Fbind b) }
         : qvar '=' texp  { unECP $3 >>= \ $3 ->
-                           ams  (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False)
-                                [mj AnnEqual $2] }
+                           fmap Left $ ams  (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False) [mj AnnEqual $2]
+                          }
                         -- RHS is a 'texp', allowing view patterns (#6038)
                         -- and, incidentally, sections.  Eg
                         -- f (R { x = show -> s }) = ...
 
         | qvar          { placeHolderPunRhs >>= \rhs ->
-                          return $ sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) rhs True }
+                          fmap Left $ return (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) rhs True)
+                        }
                         -- In the punning case, use a place-holder
                         -- The renamer fills in the final value
 
+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
+        | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp
+                        { do
+                            let top = $1
+                                fields = top : reverse $3
+                                final = last fields
+                                l = comb2 top final
+                                isPun = False
+                            $5 <- unECP $5
+                            fmap Right $ mkHsProjUpdatePV (comb2 $1 $5) (L l fields) $5 isPun
+                        }
+
+        -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
+        | field TIGHT_INFIX_PROJ fieldToUpdate
+                        { do
+                            let top = $1
+                                fields = top : reverse $3
+                                final = last fields
+                                l = comb2 top final
+                                isPun = True
+                            var <- mkHsVarPV (noLoc (mkRdrUnqual . mkVarOcc . unpackFS . unLoc $ final))
+                            fmap Right $ mkHsProjUpdatePV l (L l fields) var isPun
+                        }
+
+fieldToUpdate :: { [Located FastString] }
+fieldToUpdate
+        -- See Note [Whitespace-sensitive operator parsing] in Lexer.x
+        : fieldToUpdate TIGHT_INFIX_PROJ field { $3 : $1 }
+        | field { [$1] }
+
 -----------------------------------------------------------------------------
 -- Implicit Parameter Bindings
 
@@ -3649,6 +3717,9 @@ qvar    :: { Located RdrName }
 -- whether it's a qvar or a var can be postponed until
 -- *after* we see the close paren.
 
+field :: { Located FastString  }
+      : VARID { sL1 $1 $! getVARID $1 }
+
 qvarid :: { Located RdrName }
         : varid               { $1 }
         | QVARID              { sL1 $1 $! mkQual varName (getQVARID $1) }
diff --git a/compiler/GHC/Parser/Errors.hs b/compiler/GHC/Parser/Errors.hs
index f0f4372c8a..83812f7673 100644
--- a/compiler/GHC/Parser/Errors.hs
+++ b/compiler/GHC/Parser/Errors.hs
@@ -153,6 +153,15 @@ data PsErrorDesc
    | PsErrPrecedenceOutOfRange !Int
       -- ^ Precedence out of range
 
+   | PsErrOverloadedRecordDotInvalid
+      -- ^ Invalid use of record dot syntax `.'
+
+   | PsErrOverloadedRecordUpdateNotEnabled
+      -- ^ `OverloadedRecordUpdate` is not enabled.
+
+   | PsErrOverloadedRecordUpdateNoQualifiedFields
+      -- ^ Can't use qualified fields when OverloadedRecordUpdate is enabled.
+
    | PsErrInvalidDataCon !(HsType GhcPs)
       -- ^ Cannot parse data constructor in a data/newtype declaration
 
diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs
index 8e083b0141..47c8104fd1 100644
--- a/compiler/GHC/Parser/Errors/Ppr.hs
+++ b/compiler/GHC/Parser/Errors/Ppr.hs
@@ -234,6 +234,15 @@ pp_err = \case
    PsErrPrecedenceOutOfRange i
       -> text "Precedence out of range: " <> int i
 
+   PsErrOverloadedRecordDotInvalid
+      -> text "Use of OverloadedRecordDot '.' not valid ('.' isn't allowed when constructing records or in record patterns)"
+
+   PsErrOverloadedRecordUpdateNoQualifiedFields
+      -> text "Fields cannot be qualified when OverloadedRecordUpdate is enabled"
+
+   PsErrOverloadedRecordUpdateNotEnabled
+      -> text "OverloadedRecordUpdate needs to be enabled"
+
    PsErrInvalidDataCon t
       -> hang (text "Cannot parse data constructor in a data/newtype declaration:") 2
               (ppr t)
@@ -607,4 +616,3 @@ pp_hint = \case
 
 perhaps_as_pat :: SDoc
 perhaps_as_pat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"
-
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index b7a3daced5..71fccbe7c5 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -616,6 +616,19 @@ $tab          { warnTab }
 --            |               |   ordinary operator or type operator,
 --            |               |   e.g.  xs ~ 3, (~ x), Int ~ Bool
 --  ----------+---------------+------------------------------------------
+--    .       |  prefix       | ITproj True
+--            |               |   field projection,
+--            |               |   e.g.  .x
+--            |  tight infix  | ITproj False
+--            |               |   field projection,
+--            |               |   e.g. r.x
+--            |  suffix       | ITdot
+--            |               |   function composition,
+--            |               |   e.g. f. g
+--            |  loose infix  | ITdot
+--            |               |   function composition,
+--            |               |   e.g.  f . g
+--  ----------+---------------+------------------------------------------
 --    $  $$   |  prefix       | ITdollar, ITdollardollar
 --            |               |   untyped or typed Template Haskell splice,
 --            |               |   e.g.  $(f x), $$(f x), $$"str"
@@ -777,6 +790,7 @@ data Token
   | ITpercent  -- Prefix (%) only, e.g. a %1 -> b
   | ITstar              IsUnicodeSyntax
   | ITdot
+  | ITproj Bool -- Extension: OverloadedRecordDotBit
 
   | ITbiglam                    -- GHC-extension symbols
 
@@ -1594,6 +1608,9 @@ varsym_prefix = sym $ \span exts s ->
      | s == fsLit "-" ->
          return ITprefixminus -- Only when LexicalNegation is on, otherwise we get ITminus
                               -- and don't hit this code path. See Note [Minus tokens]
+     | s == fsLit ".", OverloadedRecordDotBit `xtest` exts ->
+         return (ITproj True) -- e.g. '(.x)'
+     | s == fsLit "." -> return ITdot
      | s == fsLit "!" -> return ITbang
      | s == fsLit "~" -> return ITtilde
      | otherwise ->
@@ -1614,8 +1631,10 @@ varsym_suffix = sym $ \span _ s ->
 
 -- See Note [Whitespace-sensitive operator parsing]
 varsym_tight_infix :: Action
-varsym_tight_infix = sym $ \span _ s ->
+varsym_tight_infix = sym $ \span exts s ->
   if | s == fsLit "@" -> return ITat
+     | s == fsLit ".", OverloadedRecordDotBit `xtest` exts  -> return (ITproj False)
+     | s == fsLit "." -> return ITdot
      | otherwise ->
          do { addWarning Opt_WarnOperatorWhitespace $
                 PsWarnOperatorWhitespace (mkSrcSpanPs span) s
@@ -1624,7 +1643,11 @@ varsym_tight_infix = sym $ \span _ s ->
 
 -- See Note [Whitespace-sensitive operator parsing]
 varsym_loose_infix :: Action
-varsym_loose_infix = sym (\_ _ s -> return $ ITvarsym s)
+varsym_loose_infix = sym $ \_ _ s ->
+  if | s == fsLit "."
+     -> return ITdot
+     | otherwise
+     -> return $ ITvarsym s
 
 consym :: Action
 consym = sym (\_span _exts s -> return $ ITconsym s)
@@ -1632,8 +1655,13 @@ consym = sym (\_span _exts s -> return $ ITconsym s)
 sym :: (PsSpan -> ExtsBitmap -> FastString -> P Token) -> Action
 sym con span buf len =
   case lookupUFM reservedSymsFM fs of
-    Just (keyword, NormalSyntax, 0) ->
-      return $ L span keyword
+    Just (keyword, NormalSyntax, 0) -> do
+      exts <- getExts
+      if fs == fsLit "." &&
+         exts .&. (xbit OverloadedRecordDotBit) /= 0 &&
+         xtest OverloadedRecordDotBit exts
+      then L span <$!> con span exts fs  -- Process by varsym_*.
+      else return $ L span keyword
     Just (keyword, NormalSyntax, i) -> do
       exts <- getExts
       if exts .&. i /= 0
@@ -2641,6 +2669,8 @@ data ExtBits
   | ImportQualifiedPostBit
   | LinearTypesBit
   | NoLexicalNegationBit   -- See Note [Why not LexicalNegationBit]
+  | OverloadedRecordDotBit
+  | OverloadedRecordUpdateBit
 
   -- Flags that are updated once parsing starts
   | InRulePragBit
@@ -2716,7 +2746,9 @@ mkParserOpts warningFlags extensionFlags
       .|. GadtSyntaxBit               `xoptBit` LangExt.GADTSyntax
       .|. ImportQualifiedPostBit      `xoptBit` LangExt.ImportQualifiedPost
       .|. LinearTypesBit              `xoptBit` LangExt.LinearTypes
-      .|. NoLexicalNegationBit     `xoptNotBit` LangExt.LexicalNegation -- See Note [Why not LexicalNegationBit]
+      .|. NoLexicalNegationBit        `xoptNotBit` LangExt.LexicalNegation -- See Note [Why not LexicalNegationBit]
+      .|. OverloadedRecordDotBit      `xoptBit` LangExt.OverloadedRecordDot
+      .|. OverloadedRecordUpdateBit   `xoptBit` LangExt.OverloadedRecordUpdate  -- Enable testing via 'getBit OverloadedRecordUpdateBit' in the parser (RecordDotSyntax parsing uses that information).
     optBits =
           HaddockBit        `setBitIf` isHaddock
       .|. RawTokenStreamBit `setBitIf` rawTokStream
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 3159902647..234df36be9 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE TypeFamilies      #-}
 {-# LANGUAGE ViewPatterns      #-}
+{-# LANGUAGE LambdaCase        #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 
@@ -15,6 +16,7 @@
 -- Functions over HsSyn specialised to RdrName.
 
 module GHC.Parser.PostProcess (
+        mkRdrGetField, mkRdrProjection, isGetField, Fbind, -- RecordDot
         mkHsOpApp,
         mkHsIntegral, mkHsFractional, mkHsIsString,
         mkHsDo, mkSpliceDecl,
@@ -27,7 +29,7 @@ module GHC.Parser.PostProcess (
         mkFamDecl,
         mkInlinePragma,
         mkPatSynMatchGroup,
-        mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
+        mkRecConstrOrUpdate,
         mkTyClD, mkInstD,
         mkRdrRecordCon, mkRdrRecordUpd,
         setRdrNameSpace,
@@ -107,7 +109,7 @@ module GHC.Parser.PostProcess (
 import GHC.Prelude
 import GHC.Hs           -- Lots of it
 import GHC.Core.TyCon          ( TyCon, isTupleTyCon, tyConSingleDataCon_maybe )
-import GHC.Core.DataCon        ( DataCon, dataConTyCon )
+import GHC.Core.DataCon        ( DataCon, dataConTyCon, FieldLabelString )
 import GHC.Core.ConLike        ( ConLike(..) )
 import GHC.Core.Coercion.Axiom ( Role, fsFromRole )
 import GHC.Types.Name.Reader
@@ -135,7 +137,8 @@ import GHC.Data.Maybe
 import GHC.Data.Bag
 import GHC.Utils.Misc
 import GHC.Parser.Annotation
-import Data.List (findIndex)
+import Data.Either
+import Data.List
 import Data.Foldable
 import GHC.Driver.Flags ( WarningFlag(..) )
 import GHC.Utils.Panic
@@ -148,7 +151,6 @@ import Data.Kind       ( Type )
 
 #include "HsVersions.h"
 
-
 {- **********************************************************************
 
   Construction functions for Rdr stuff
@@ -1243,6 +1245,10 @@ ecpFromExp a = ECP (ecpFromExp' a)
 ecpFromCmd :: LHsCmd GhcPs -> ECP
 ecpFromCmd a = ECP (ecpFromCmd' a)
 
+-- The 'fbinds' parser rule produces values of this type. See Note
+-- [RecordDotSyntax field updates].
+type Fbind b = Either (LHsRecField GhcPs (Located b)) (LHsRecProj GhcPs (Located b))
+
 -- | Disambiguate infix operators.
 -- See Note [Ambiguous syntactic categories]
 class DisambInfixOp b where
@@ -1270,6 +1276,8 @@ class b ~ (Body b) GhcPs => DisambECP b where
   ecpFromCmd' :: LHsCmd GhcPs -> PV (Located b)
   -- | Return an expression without ambiguity, or fail in a non-expression context.
   ecpFromExp' :: LHsExpr GhcPs -> PV (Located b)
+  -- | This can only be satified by expressions.
+  mkHsProjUpdatePV :: SrcSpan -> Located [Located FieldLabelString] -> Located b -> Bool -> PV (LHsRecProj GhcPs (Located b))
   -- | Disambiguate "\... -> ..." (lambda)
   mkHsLamPV :: SrcSpan -> MatchGroup GhcPs (Located b) -> PV (Located b)
   -- | Disambiguate "let ... in ..."
@@ -1326,10 +1334,11 @@ class b ~ (Body b) GhcPs => DisambECP b where
   mkHsSplicePV :: Located (HsSplice GhcPs) -> PV (Located b)
   -- | Disambiguate "f { a = b, ... }" syntax (record construction and record updates)
   mkHsRecordPV ::
+    Bool -> -- Is OverloadedRecordUpdate in effect?
     SrcSpan ->
     SrcSpan ->
     Located b ->
-    ([LHsRecField GhcPs (Located b)], Maybe SrcSpan) ->
+    ([Fbind b], Maybe SrcSpan) ->
     PV (Located b)
   -- | Disambiguate "-a" (negation)
   mkHsNegAppPV :: SrcSpan -> Located b -> PV (Located b)
@@ -1348,7 +1357,6 @@ class b ~ (Body b) GhcPs => DisambECP b where
   -- | Validate infixexp LHS to reject unwanted {-# SCC ... #-} pragmas
   rejectPragmaPV :: Located b -> PV ()
 
-
 {- Note [UndecidableSuperClasses for associated types]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 (This Note is about the code in GHC, not about the user code that we are parsing)
@@ -1397,6 +1405,7 @@ instance DisambECP (HsCmd GhcPs) where
   type Body (HsCmd GhcPs) = HsCmd
   ecpFromCmd' = return
   ecpFromExp' (L l e) = cmdFail l (ppr e)
+  mkHsProjUpdatePV l _ _ _ = addFatalError $ PsError PsErrOverloadedRecordDotInvalid [] l
   mkHsLamPV l mg = return $ L l (HsCmdLam noExtField mg)
   mkHsLetPV l bs e = return $ L l (HsCmdLet noExtField bs e)
   type InfixOp (HsCmd GhcPs) = HsExpr GhcPs
@@ -1427,8 +1436,11 @@ instance DisambECP (HsCmd GhcPs) where
   mkHsExplicitListPV l xs = cmdFail l $
     brackets (fsep (punctuate comma (map ppr xs)))
   mkHsSplicePV (L l sp) = cmdFail l (ppr sp)
-  mkHsRecordPV l _ a (fbinds, ddLoc) = cmdFail l $
-    ppr a <+> ppr (mk_rec_fields fbinds ddLoc)
+  mkHsRecordPV _ l _ a (fbinds, ddLoc) = do
+    let (fs, ps) = partitionEithers fbinds
+    if not (null ps)
+      then addFatalError $ PsError PsErrOverloadedRecordDotInvalid [] l
+      else cmdFail l $ ppr a <+> ppr (mk_rec_fields fs ddLoc)
   mkHsNegAppPV l a = cmdFail l (text "-" <> ppr a)
   mkHsSectionR_PV l op c = cmdFail l $
     let pp_op = fromMaybe (panic "cannot print infix operator")
@@ -1454,6 +1466,7 @@ instance DisambECP (HsExpr GhcPs) where
     addError $ PsError (PsErrArrowCmdInExpr c) [] l
     return (L l hsHoleExpr)
   ecpFromExp' = return
+  mkHsProjUpdatePV l fields arg isPun = return $ mkRdrProjUpdate l fields arg isPun
   mkHsLamPV l mg = return $ L l (HsLam noExtField mg)
   mkHsLetPV l bs c = return $ L l (HsLet noExtField bs c)
   type InfixOp (HsExpr GhcPs) = HsExpr GhcPs
@@ -1483,8 +1496,8 @@ instance DisambECP (HsExpr GhcPs) where
   mkHsTySigPV l a sig = return $ L l (ExprWithTySig noExtField a (hsTypeToHsSigWcType sig))
   mkHsExplicitListPV l xs = return $ L l (ExplicitList noExtField xs)
   mkHsSplicePV sp = return $ mapLoc (HsSpliceE noExtField) sp
-  mkHsRecordPV l lrec a (fbinds, ddLoc) = do
-    r <- mkRecConstrOrUpdate a lrec (fbinds, ddLoc)
+  mkHsRecordPV opts l lrec a (fbinds, ddLoc) = do
+    r <- mkRecConstrOrUpdate opts a lrec (fbinds, ddLoc)
     checkRecordSyntax (L l r)
   mkHsNegAppPV l a = return $ L l (NegApp noExtField a noSyntaxExpr)
   mkHsSectionR_PV l op e = return $ L l (SectionR noExtField op e)
@@ -1512,6 +1525,7 @@ instance DisambECP (PatBuilder GhcPs) where
   ecpFromExp' (L l e)    = addFatalError $ PsError (PsErrArrowExprInPat e) [] l
   mkHsLamPV l _          = addFatalError $ PsError PsErrLambdaInPat [] l
   mkHsLetPV l _ _        = addFatalError $ PsError PsErrLetInPat [] l
+  mkHsProjUpdatePV l _ _ _ = addFatalError $ PsError PsErrOverloadedRecordDotInvalid [] l
   type InfixOp (PatBuilder GhcPs) = RdrName
   superInfixOp m = m
   mkHsOpAppPV l p1 op p2 = return $ L l $ PatBuilderOpApp p1 op p2
@@ -1537,9 +1551,13 @@ instance DisambECP (PatBuilder GhcPs) where
     ps <- traverse checkLPat xs
     return (L l (PatBuilderPat (ListPat noExtField ps)))
   mkHsSplicePV (L l sp) = return $ L l (PatBuilderPat (SplicePat noExtField sp))
-  mkHsRecordPV l _ a (fbinds, ddLoc) = do
-    r <- mkPatRec a (mk_rec_fields fbinds ddLoc)
-    checkRecordSyntax (L l r)
+  mkHsRecordPV _ l _ a (fbinds, ddLoc) = do
+    let (fs, ps) = partitionEithers fbinds
+    if not (null ps)
+     then addFatalError $ PsError PsErrOverloadedRecordDotInvalid [] l
+     else do
+       r <- mkPatRec a (mk_rec_fields fs ddLoc)
+       checkRecordSyntax (L l r)
   mkHsNegAppPV l (L lp p) = do
     lit <- case p of
       PatBuilderOverLit pos_lit -> return (L lp pos_lit)
@@ -2135,23 +2153,71 @@ checkPrecP (L l (_,i)) (L _ ol)
                                    , getRdrName unrestrictedFunTyCon ]
 
 mkRecConstrOrUpdate
-        :: LHsExpr GhcPs
+        :: Bool
+        -> LHsExpr GhcPs
         -> SrcSpan
-        -> ([LHsRecField GhcPs (LHsExpr GhcPs)], Maybe SrcSpan)
+        -> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan)
         -> PV (HsExpr GhcPs)
-
-mkRecConstrOrUpdate (L l (HsVar _ (L _ c))) _ (fs,dd)
+mkRecConstrOrUpdate _ (L l (HsVar _ (L _ c))) _lrec (fbinds,dd)
   | isRdrDataCon c
-  = return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd))
-mkRecConstrOrUpdate exp _ (fs,dd)
+  = do
+      let (fs, ps) = partitionEithers fbinds
+      if not (null ps)
+        then addFatalError $ PsError PsErrOverloadedRecordDotInvalid [] (getLoc (head ps))
+        else return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd))
+mkRecConstrOrUpdate overloaded_update exp _ (fs,dd)
   | Just dd_loc <- dd = addFatalError $ PsError PsErrDotsInRecordUpdate [] dd_loc
-  | otherwise = return (mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) fs))
-
-mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs
-mkRdrRecordUpd exp flds
-  = RecordUpd { rupd_ext  = noExtField
-              , rupd_expr = exp
-              , rupd_flds = flds }
+  | otherwise = mkRdrRecordUpd overloaded_update exp fs
+
+mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> PV (HsExpr GhcPs)
+mkRdrRecordUpd overloaded_on exp@(L loc _) fbinds = do
+  -- We do not need to know if OverloadedRecordDot is in effect. We do
+  -- however need to know if OverloadedRecordUpdate (passed in
+  -- overloaded_on) is in effect because it affects the Left/Right nature
+  -- of the RecordUpd value we calculate.
+  let (fs, ps) = partitionEithers fbinds
+      fs' = map (fmap mk_rec_upd_field) fs
+  case overloaded_on of
+    False | not $ null ps ->
+      -- A '.' was found in an update and OverloadedRecordUpdate isn't on.
+      addFatalError $ PsError PsErrOverloadedRecordUpdateNotEnabled [] loc
+    False ->
+      -- This is just a regular record update.
+      return RecordUpd {
+        rupd_ext = noExtField
+      , rupd_expr = exp
+      , rupd_flds = Left fs' }
+    True -> do
+      let qualifiedFields =
+            [ L l lbl | L _ (HsRecField (L l lbl) _ _) <- fs'
+                      , isQual . rdrNameAmbiguousFieldOcc $ lbl
+            ]
+      if not $ null qualifiedFields
+        then
+          addFatalError $ PsError PsErrOverloadedRecordUpdateNoQualifiedFields [] (getLoc (head qualifiedFields))
+        else -- This is a RecordDotSyntax update.
+          return RecordUpd {
+            rupd_ext = noExtField
+           , rupd_expr = exp
+           , rupd_flds = Right (toProjUpdates fbinds) }
+  where
+    toProjUpdates :: [Fbind (HsExpr GhcPs)] -> [LHsRecUpdProj GhcPs]
+    toProjUpdates = map (\case { Right p -> p; Left f -> recFieldToProjUpdate f })
+
+    -- Convert a top-level field update like {foo=2} or {bar} (punned)
+    -- to a projection update.
+    recFieldToProjUpdate :: LHsRecField GhcPs  (LHsExpr GhcPs) -> LHsRecUpdProj GhcPs
+    recFieldToProjUpdate (L l (HsRecField (L _ (FieldOcc _ (L loc rdr))) arg pun)) =
+        -- The idea here is to convert the label to a singleton [FastString].
+        let f = occNameFS . rdrNameOcc $ rdr
+        in mkRdrProjUpdate l (L loc [L loc f]) (punnedVar f) pun
+        where
+          -- If punning, compute HsVar "f" otherwise just arg. This
+          -- has the effect that sentinel HsVar "pun-rhs" is replaced
+          -- by HsVar "f" here, before the update is written to a
+          -- setField expressions.
+          punnedVar :: FastString -> LHsExpr GhcPs
+          punnedVar f  = if not pun then arg else noLoc . HsVar noExtField . noLoc . mkRdrUnqual . mkVarOccFS $ f
 
 mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs
 mkRdrRecordCon con flds
@@ -2632,3 +2698,36 @@ mkMultTy u tok t = (HsExplicitMult u t, AddAnn AnnPercent (getLoc tok))
 starSym :: Bool -> String
 starSym True = "★"
 starSym False = "*"
+
+-----------------------------------------
+-- Bits and pieces for RecordDotSyntax.
+
+-- Test if the expression is a 'getField @"..."' expression.
+isGetField :: LHsExpr GhcPs -> Bool
+isGetField (L _ HsGetField{}) = True
+isGetField _ = False
+
+mkRdrGetField :: SrcSpan -> LHsExpr GhcPs -> Located FieldLabelString -> LHsExpr GhcPs
+mkRdrGetField loc arg field =
+  L loc HsGetField {
+      gf_ext = noExtField
+    , gf_expr = arg
+    , gf_field = field
+    }
+
+mkRdrProjection :: SrcSpan -> [Located FieldLabelString] -> LHsExpr GhcPs
+mkRdrProjection _ [] = panic "mkRdrProjection: The impossible has happened!"
+mkRdrProjection loc flds =
+  L loc HsProjection {
+      proj_ext = noExtField
+    , proj_flds = flds
+    }
+
+mkRdrProjUpdate :: SrcSpan -> Located [Located FieldLabelString] -> LHsExpr GhcPs -> Bool -> LHsRecProj GhcPs (LHsExpr GhcPs)
+mkRdrProjUpdate _ (L _ []) _ _ = panic "mkRdrProjUpdate: The impossible has happened!"
+mkRdrProjUpdate loc (L l flds) arg isPun =
+  L loc HsRecField {
+      hsRecFieldLbl = L l (FieldLabelStrings flds)
+    , hsRecFieldArg = arg
+    , hsRecPun = isPun
+  }
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index fad921265a..1ffbc4371a 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -304,6 +304,25 @@ rnExpr (NegApp _ e _)
        ; return (final_e, fv_e `plusFV` fv_neg) }
 
 ------------------------------------------
+-- Record dot syntax
+
+rnExpr (HsGetField _ e f)
+ = do { (getField, fv_getField) <- lookupSyntaxName getFieldName
+      ; (e, fv_e) <- rnLExpr e
+      ; return ( mkExpandedExpr
+                   (HsGetField noExtField e f)
+                   (mkGetField getField e f)
+               , fv_e `plusFV` fv_getField ) }
+
+rnExpr (HsProjection _ fs)
+  = do { (getField, fv_getField) <- lookupSyntaxName getFieldName
+       ; circ <- lookupOccRn compose_RDR
+       ; return ( mkExpandedExpr
+                    (HsProjection noExtField fs)
+                    (mkProjection getField circ fs)
+                , unitFV circ `plusFV` fv_getField) }
+
+------------------------------------------
 -- Template Haskell extensions
 rnExpr e@(HsBracket _ br_body) = rnBracket e br_body
 
@@ -406,11 +425,28 @@ rnExpr (RecordCon { rcon_con = con_id
                             ; return (L l (fld { hsRecFieldArg = arg' }), fvs) }
 
 rnExpr (RecordUpd { rupd_expr = expr, rupd_flds = rbinds })
-  = do  { (expr', fvExpr) <- rnLExpr expr
-        ; (rbinds', fvRbinds) <- rnHsRecUpdFields rbinds
-        ; return (RecordUpd { rupd_ext = noExtField, rupd_expr = expr'
-                            , rupd_flds = rbinds' }
-                 , fvExpr `plusFV` fvRbinds) }
+  = case rbinds of
+      Left flds -> -- 'OverloadedRecordUpdate' is not in effect. Regular record update.
+        do  { ; (e, fv_e) <- rnLExpr expr
+              ; (rs, fv_rs) <- rnHsRecUpdFields flds
+              ; return ( RecordUpd noExtField e (Left rs), fv_e `plusFV` fv_rs )
+            }
+      Right flds ->  -- 'OverloadedRecordUpdate' is in effect. Record dot update desugaring.
+        do { ; unlessXOptM LangExt.RebindableSyntax $
+                 addErr $ text "RebindableSyntax is required if OverloadedRecordUpdate is enabled."
+             ; let punnedFields = [fld | (L _ fld) <- flds, hsRecPun fld]
+             ; punsEnabled <-xoptM LangExt.RecordPuns
+             ; unless (null punnedFields || punsEnabled) $
+                 addErr $ text "For this to work enable NamedFieldPuns."
+             ; (getField, fv_getField) <- lookupSyntaxName getFieldName
+             ; (setField, fv_setField) <- lookupSyntaxName setFieldName
+             ; (e, fv_e) <- rnLExpr expr
+             ; (us, fv_us) <- rnHsUpdProjs flds
+             ; return ( mkExpandedExpr
+                          (RecordUpd noExtField e (Right us))
+                          (mkRecordDotUpd getField setField e us)
+                         , plusFVs [fv_getField, fv_setField, fv_e, fv_us] )
+             }
 
 rnExpr (ExprWithTySig _ expr pty)
   = do  { (pty', fvTy)    <- rnHsSigWcType ExprWithTySigCtx pty
@@ -2497,6 +2533,12 @@ genLHsVar nm = wrapGenSpan $ genHsVar nm
 genHsVar :: Name -> HsExpr GhcRn
 genHsVar nm = HsVar noExtField $ wrapGenSpan nm
 
+genAppType :: HsExpr GhcRn -> HsType (NoGhcTc GhcRn) -> HsExpr GhcRn
+genAppType expr = HsAppType noExtField (wrapGenSpan expr) . mkEmptyWildCardBndrs . wrapGenSpan
+
+genHsTyLit :: FastString -> HsType GhcRn
+genHsTyLit = HsTyLit noExtField . HsStrTy NoSourceText
+
 wrapGenSpan :: a -> Located a
 -- Wrap something in a "generatedSrcSpan"
 -- See Note [Rebindable syntax and HsExpansion]
@@ -2510,3 +2552,72 @@ mkExpandedExpr
   -> HsExpr GhcRn           -- ^ expanded expression
   -> HsExpr GhcRn           -- ^ suitably wrapped 'HsExpansion'
 mkExpandedExpr a b = XExpr (HsExpanded a b)
+
+-----------------------------------------
+-- Bits and pieces for RecordDotSyntax.
+--
+-- See Note [Overview of record dot syntax] in GHC.Hs.Expr.
+
+-- mkGetField arg field calcuates a get_field @field arg expression.
+-- e.g. z.x = mkGetField z x = get_field @x z
+mkGetField :: Name -> LHsExpr GhcRn -> Located FieldLabelString -> HsExpr GhcRn
+mkGetField get_field arg field = unLoc (head $ mkGet get_field [arg] field)
+
+-- mkSetField a field b calculates a set_field @field expression.
+-- e.g mkSetSetField a field b = set_field @"field" a b (read as "set field 'field' on a to b").
+mkSetField :: Name -> LHsExpr GhcRn -> Located FieldLabelString -> LHsExpr GhcRn -> HsExpr GhcRn
+mkSetField set_field a (L _ field) b =
+  genHsApp (genHsApp (genHsVar set_field `genAppType` genHsTyLit field)  a) b
+
+mkGet :: Name -> [LHsExpr GhcRn] -> Located FieldLabelString -> [LHsExpr GhcRn]
+mkGet get_field l@(r : _) (L _ field) =
+  wrapGenSpan (genHsApp (genHsVar get_field `genAppType` genHsTyLit field) r) : l
+mkGet _ [] _ = panic "mkGet : The impossible has happened!"
+
+mkSet :: Name -> LHsExpr GhcRn -> (Located FieldLabelString, LHsExpr GhcRn) -> LHsExpr GhcRn
+mkSet set_field acc (field, g) = wrapGenSpan (mkSetField set_field g field acc)
+
+-- mkProjection fields calculates a projection.
+-- e.g. .x = mkProjection [x] = getField @"x"
+--      .x.y = mkProjection [.x, .y] = (.y) . (.x) = getField @"y" . getField @"x"
+mkProjection :: Name -> Name -> [Located FieldLabelString] -> HsExpr GhcRn
+mkProjection getFieldName circName (field : fields) = foldl' f (proj field) fields
+  where
+    f :: HsExpr GhcRn -> Located FieldLabelString -> HsExpr GhcRn
+    f acc field = genHsApps circName $ map wrapGenSpan [proj field, acc]
+
+    proj :: Located FieldLabelString -> HsExpr GhcRn
+    proj (L _ f) = genHsVar getFieldName `genAppType` genHsTyLit f
+mkProjection _ _ [] = panic "mkProjection: The impossible happened"
+
+-- mkProjUpdateSetField calculates functions representing dot notation record updates.
+-- e.g. Suppose an update like foo.bar = 1.
+--      We calculate the function \a -> setField @"foo" a (setField @"bar" (getField @"foo" a) 1).
+mkProjUpdateSetField :: Name -> Name -> LHsRecProj GhcRn (LHsExpr GhcRn) -> (LHsExpr GhcRn -> LHsExpr GhcRn)
+mkProjUpdateSetField get_field set_field (L _ (HsRecField { hsRecFieldLbl = (L _ (FieldLabelStrings flds)), hsRecFieldArg = arg } ))
+  = let {
+      ; final = last flds  -- quux
+      ; fields = init flds   -- [foo, bar, baz]
+      ; getters = \a -> foldl' (mkGet get_field) [a] fields  -- Ordered from deep to shallow.
+          -- [getField@"baz"(getField@"bar"(getField@"foo" a), getField@"bar"(getField@"foo" a), getField@"foo" a, a]
+      ; zips = \a -> (final, head (getters a)) : zip (reverse fields) (tail (getters a)) -- Ordered from deep to shallow.
+          -- [("quux", getField@"baz"(getField@"bar"(getField@"foo" a)), ("baz", getField@"bar"(getField@"foo" a)), ("bar", getField@"foo" a), ("foo", a)]
+      }
+    in (\a -> foldl' (mkSet set_field) arg (zips a))
+          -- setField@"foo" (a) (setField@"bar" (getField @"foo" (a))(setField@"baz" (getField @"bar" (getField @"foo" (a)))(setField@"quux" (getField @"baz" (getField @"bar" (getField @"foo" (a))))(quux))))
+
+mkRecordDotUpd :: Name -> Name -> LHsExpr GhcRn -> [LHsRecUpdProj GhcRn] -> HsExpr GhcRn
+mkRecordDotUpd get_field set_field exp updates = foldl' fieldUpdate (unLoc exp) updates
+  where
+    fieldUpdate :: HsExpr GhcRn -> LHsRecUpdProj GhcRn -> HsExpr GhcRn
+    fieldUpdate acc lpu =  unLoc $ (mkProjUpdateSetField get_field set_field lpu) (wrapGenSpan acc)
+
+rnHsUpdProjs :: [LHsRecUpdProj GhcPs] -> RnM ([LHsRecUpdProj GhcRn], FreeVars)
+rnHsUpdProjs us = do
+  (u, fvs) <- unzip <$> mapM rnRecUpdProj us
+  pure (u, plusFVs fvs)
+  where
+    rnRecUpdProj :: LHsRecUpdProj GhcPs -> RnM (LHsRecUpdProj GhcRn, FreeVars)
+    rnRecUpdProj (L l (HsRecField fs arg pun))
+      = do { (arg, fv) <- rnLExpr arg
+           ; return $ (L l (HsRecField { hsRecFieldLbl = fs, hsRecFieldArg = arg, hsRecPun = pun}), fv) }
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index dc0d244fc1..a74af6e564 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -639,7 +639,11 @@ following.
 
 -}
 
-tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = rbnds }) res_ty
+-- Record updates via dot syntax are replaced by desugared expressions
+-- in the renamer. See Note [Overview of record dot syntax] in
+-- GHC.Hs.Expr. This is why we match on 'rupd_flds = Left rbnds' here
+-- and panic otherwise.
+tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = Left rbnds }) res_ty
   = ASSERT( notNull rbnds )
     do  { -- STEP -2: typecheck the record_expr, the record to be updated
           (record_expr', record_rho) <- tcScalingUsage Many $ tcInferRho record_expr
@@ -805,11 +809,12 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = rbnds }) res_ty
                                    , rupd_out_tys = result_inst_tys
                                    , rupd_wrap = req_wrap }
               expr' = RecordUpd { rupd_expr = mkLHsWrap fam_co $
-                                              mkLHsWrapCo co_scrut record_expr'
-                                , rupd_flds = rbinds'
+                                                mkLHsWrapCo co_scrut record_expr'
+                                , rupd_flds = Left rbinds'
                                 , rupd_ext = upd_tc }
 
         ; tcWrapResult expr expr' rec_res_ty res_ty }
+tcExpr (RecordUpd {}) _ = panic "GHC.Tc.Gen.Expr: tcExpr: The impossible happened!"
 
 
 {-
@@ -828,6 +833,19 @@ tcExpr (ArithSeq _ witness seq) res_ty
 {-
 ************************************************************************
 *                                                                      *
+                Record dot syntax
+*                                                                      *
+************************************************************************
+-}
+
+-- These terms have been replaced by desugaring in the renamer. See
+-- Note [Overview of record dot syntax].
+tcExpr (HsGetField _ _ _) _ = panic "GHC.Tc.Gen.Expr: tcExpr: HsGetField: Not implemented"
+tcExpr (HsProjection _ _) _ = panic "GHC.Tc.Gen.Expr: tcExpr: HsProjection: Not implemented"
+
+{-
+************************************************************************
+*                                                                      *
                 Template Haskell
 *                                                                      *
 ************************************************************************
@@ -1274,7 +1292,7 @@ disambiguateRecordBinds record_expr record_rho rbnds res_ty
                , text "This will not be supported by -XDuplicateRecordFields in future releases of GHC."
                ]
       where
-        rupd = RecordUpd { rupd_expr = record_expr, rupd_flds = rbnds, rupd_ext = noExtField }
+        rupd = RecordUpd { rupd_expr = record_expr, rupd_flds = Left rbnds, rupd_ext = noExtField }
         loc  = getLoc (head rbnds)
 
 {-
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index 648bf5ce12..b1dd472d75 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -375,6 +375,7 @@ data CtOrigin
   | AssocFamPatOrigin   -- When matching the patterns of an associated
                         -- family instance with that of its parent class
   | SectionOrigin
+  | HasFieldOrigin FastString
   | TupleOrigin         -- (..,..)
   | ExprSigOrigin       -- e :: ty
   | PatSigOrigin        -- p :: ty
@@ -478,6 +479,7 @@ lexprCtOrigin (L _ e) = exprCtOrigin e
 
 exprCtOrigin :: HsExpr GhcRn -> CtOrigin
 exprCtOrigin (HsVar _ (L _ name)) = OccurrenceOf name
+exprCtOrigin (HsGetField _ _ (L _ f)) = HasFieldOrigin f
 exprCtOrigin (HsUnboundVar {})    = Shouldn'tHappenOrigin "unbound variable"
 exprCtOrigin (HsConLikeOut {})    = panic "exprCtOrigin HsConLikeOut"
 exprCtOrigin (HsRecFld _ f)       = OccurrenceOfRecSel (rdrNameAmbiguousFieldOcc f)
@@ -493,6 +495,7 @@ exprCtOrigin (HsAppType _ e1 _)   = lexprCtOrigin e1
 exprCtOrigin (OpApp _ _ op _)     = lexprCtOrigin op
 exprCtOrigin (NegApp _ e _)       = lexprCtOrigin e
 exprCtOrigin (HsPar _ e)          = lexprCtOrigin e
+exprCtOrigin (HsProjection _ _)   = SectionOrigin
 exprCtOrigin (SectionL _ _ _)     = SectionOrigin
 exprCtOrigin (SectionR _ _ _)     = SectionOrigin
 exprCtOrigin (ExplicitTuple {})   = Shouldn'tHappenOrigin "explicit tuple"
@@ -629,6 +632,7 @@ pprCtO IfOrigin              = text "an if expression"
 pprCtO (LiteralOrigin lit)   = hsep [text "the literal", quotes (ppr lit)]
 pprCtO (ArithSeqOrigin seq)  = hsep [text "the arithmetic sequence", quotes (ppr seq)]
 pprCtO SectionOrigin         = text "an operator section"
+pprCtO (HasFieldOrigin f)    = hsep [text "selecting the field", quotes (ppr f)]
 pprCtO AssocFamPatOrigin     = text "the LHS of a family instance"
 pprCtO TupleOrigin           = text "a tuple"
 pprCtO NegateOrigin          = text "a use of syntactic negation"
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 4d4860c7e1..90717063f7 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -946,21 +946,31 @@ zonkExpr env expr@(RecordCon { rcon_ext = con_expr, rcon_flds = rbinds })
         ; return (expr { rcon_ext  = new_con_expr
                        , rcon_flds = new_rbinds }) }
 
-zonkExpr env (RecordUpd { rupd_flds = rbinds
+-- Record updates via dot syntax are replaced by desugared expressions
+-- in the renamer. See Note [Rebindable Syntax and HsExpansion]. This
+-- is why we match on 'rupd_flds = Left rbinds' here and panic otherwise.
+zonkExpr env (RecordUpd { rupd_flds = Left rbinds
                         , rupd_expr = expr
-                        , rupd_ext = RecordUpdTc
-                            { rupd_cons = cons, rupd_in_tys = in_tys
-                            , rupd_out_tys = out_tys, rupd_wrap = req_wrap }})
+                        , rupd_ext = RecordUpdTc {
+                                       rupd_cons = cons
+                                     , rupd_in_tys = in_tys
+                                     , rupd_out_tys = out_tys
+                                     , rupd_wrap = req_wrap }})
   = do  { new_expr    <- zonkLExpr env expr
         ; new_in_tys  <- mapM (zonkTcTypeToTypeX env) in_tys
         ; new_out_tys <- mapM (zonkTcTypeToTypeX env) out_tys
         ; new_rbinds  <- zonkRecUpdFields env rbinds
         ; (_, new_recwrap) <- zonkCoFn env req_wrap
-        ; return (RecordUpd { rupd_expr = new_expr, rupd_flds =  new_rbinds
-                            , rupd_ext = RecordUpdTc
-                                { rupd_cons = cons, rupd_in_tys = new_in_tys
-                                , rupd_out_tys = new_out_tys
-                                , rupd_wrap = new_recwrap }}) }
+        ; return (
+            RecordUpd {
+                  rupd_expr = new_expr
+                , rupd_flds = Left new_rbinds
+                , rupd_ext = RecordUpdTc {
+                               rupd_cons = cons
+                             , rupd_in_tys = new_in_tys
+                             , rupd_out_tys = new_out_tys
+                             , rupd_wrap = new_recwrap }}) }
+zonkExpr _ (RecordUpd {}) = panic "GHC.Tc.Utils.Zonk: zonkExpr: The impossible happened!"
 
 zonkExpr env (ExprWithTySig _ e ty)
   = do { e' <- zonkLExpr env e
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 12f65d36ca..29976e4b89 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -1020,7 +1020,7 @@ cvtl e = wrapL (cvt e)
                               ; flds'
                                   <- mapM (cvtFld (mkAmbiguousFieldOcc . noLoc))
                                            flds
-                              ; return $ mkRdrRecordUpd e' flds' }
+                              ; return $ RecordUpd noExtField e' (Left flds') }
     cvt (StaticE e)      = fmap (HsStatic noExtField) $ cvtl e
     cvt (UnboundVarE s)  = do -- Use of 'vcName' here instead of 'vName' is
                               -- important, because UnboundVarE may contain
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index 3d6500d342..9967a78314 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -40,6 +40,7 @@ import Language.Haskell.Syntax.Binds
 -- others:
 import GHC.Tc.Types.Evidence
 import GHC.Core
+import GHC.Core.DataCon (FieldLabelString)
 import GHC.Types.Name
 import GHC.Types.Basic
 import GHC.Types.Fixity
@@ -59,6 +60,110 @@ import qualified Data.Data as Data (Fixity(..))
 import GHCi.RemoteTypes ( ForeignRef )
 import qualified Language.Haskell.TH as TH (Q)
 
+{- Note [RecordDotSyntax field updates]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The extensions @OverloadedRecordDot@ @OverloadedRecordUpdate@ together
+enable record updates like @a{foo.bar.baz = 1}@. Introducing this
+syntax slightly complicates parsing. This note explains how it's done.
+
+In the event a record is being constructed or updated, it's this
+production that's in play:
+@
+aexp1 -> aexp1 '{' fbinds '}' {
+  ...
+  mkHsRecordPV ... $1 (snd $3)
+}
+@
+@fbinds@ is a list of field bindings. @mkHsRecordPV@ is a function of
+the @DisambECP b@ typeclass, see Note [Ambiguous syntactic
+categories].
+
+The "normal" rules for an @fbind@ are:
+@
+fbind
+        : qvar '=' texp
+        | qvar
+@
+These rules compute values of @LHsRecField GhcPs (Located b)@. They
+apply in the context of record construction, record updates, record
+patterns and record expressions. That is, @b@ ranges over @HsExpr
+GhcPs@, @HsPat GhcPs@ and @HsCmd GhcPs@.
+
+When @OverloadedRecordDot@ and @OverloadedRecordUpdate@ are both
+enabled, two additional @fbind@ rules are admitted:
+@
+        | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp
+        | field TIGHT_INFIX_PROJ fieldToUpdate
+@
+
+These rules only make sense when parsing record update expressions
+(that is, patterns and commands cannot be parsed by these rules and
+neither record constructions).
+
+The results of these new rules cannot be represented by @LHsRecField
+GhcPs (LHsExpr GhcPs)@ values as the type is defined today. We
+minimize modifying existing code by having these new rules calculate
+@LHsRecProj GhcPs (Located b)@ ("record projection") values instead:
+@
+newtype FieldLabelStrings = FieldLabelStrings [Located FieldLabelString]
+type RecProj arg = HsRecField' FieldLabelStrings arg
+type LHsRecProj p arg = Located (RecProj arg)
+@
+
+The @fbind@ rule is then given the type @fbind :: { forall b.
+DisambECP b => PV (Fbind b) }@ accomodating both alternatives:
+@
+type Fbind b = Either
+                  (LHsRecField GhcPs (Located b))
+                  ( LHsRecProj GhcPs (Located b))
+@
+
+In @data HsExpr p@, the @RecordUpd@ constuctor indicates regular
+updates vs. projection updates by means of the @rupd_flds@ member
+type, an @Either@ instance:
+@
+  | RecordUpd
+      { rupd_ext  :: XRecordUpd p
+      , rupd_expr :: LHsExpr p
+      , rupd_flds :: Either [LHsRecUpdField p] [LHsRecUpdProj p]
+      }
+@
+Here,
+@
+type RecUpdProj p = RecProj (LHsExpr p)
+type LHsRecUpdProj p = Located (RecUpdProj p)
+@
+and @Left@ values indicating regular record update, @Right@ values
+updates desugared to @setField@s.
+
+If @OverloadedRecordUpdate@ is enabled, any updates parsed as
+@LHsRecField GhcPs@ values are converted to @LHsRecUpdProj GhcPs@
+values (see function @mkRdrRecordUpd@ in 'GHC.Parser.PostProcess').
+-}
+
+-- | RecordDotSyntax field updates
+
+newtype FieldLabelStrings =
+  FieldLabelStrings [Located FieldLabelString]
+                               deriving (Data)
+
+instance Outputable FieldLabelStrings where
+  ppr (FieldLabelStrings flds) =
+    hcat (punctuate dot (map (ppr . unLoc) flds))
+
+-- Field projection updates (e.g. @foo.bar.baz = 1@). See Note
+-- [RecordDotSyntax field updates].
+type RecProj arg = HsRecField' FieldLabelStrings arg
+
+-- The phantom type parameter @p@ is for symmetry with @LHsRecField p
+-- arg@ in the definition of @data Fbind@ (see GHC.Parser.Process).
+type LHsRecProj p arg = Located (RecProj arg)
+
+-- These two synonyms are used in the definition of syntax @RecordUpd@
+-- below.
+type RecUpdProj p = RecProj (LHsExpr p)
+type LHsRecUpdProj p = Located (RecUpdProj p)
+
 {-
 ************************************************************************
 *                                                                      *
@@ -356,16 +461,44 @@ data HsExpr p
   --
   --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'{'@,
   --         'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnClose' @'}'@
+  --         'GHC.Parser.Annotation.AnnComma, 'GHC.Parser.Annotation.AnnDot',
+  --         'GHC.Parser.Annotation.AnnClose' @'}'@
 
   -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | RecordUpd
       { rupd_ext  :: XRecordUpd p
       , rupd_expr :: LHsExpr p
-      , rupd_flds :: [LHsRecUpdField p]
+      , rupd_flds :: Either [LHsRecUpdField p] [LHsRecUpdProj p]
       }
   -- For a type family, the arg types are of the *instance* tycon,
   -- not the family tycon
 
+  -- | Record field selection e.g @z.x@.
+  --
+  --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDot'
+  --
+  -- This case only arises when the OverloadedRecordDot langauge
+  -- extension is enabled.
+
+  | HsGetField {
+        gf_ext :: XGetField p
+      , gf_expr :: LHsExpr p
+      , gf_field :: Located FieldLabelString
+      }
+
+  -- | Record field selector. e.g. @(.x)@ or @(.x.y)@
+  --
+  --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpenP'
+  --         'GHC.Parser.Annotation.AnnDot', 'GHC.Parser.Annotation.AnnCloseP'
+  --
+  -- This case only arises when the OverloadedRecordDot langauge
+  -- extensions is enabled.
+
+  | HsProjection {
+        proj_ext :: XProjection p
+      , proj_flds :: [Located FieldLabelString]
+      }
+
   -- | Expression with an explicit type signature. @e :: type@
   --
   --  - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'
diff --git a/compiler/Language/Haskell/Syntax/Extension.hs b/compiler/Language/Haskell/Syntax/Extension.hs
index 16b11b3e30..f843bee1a2 100644
--- a/compiler/Language/Haskell/Syntax/Extension.hs
+++ b/compiler/Language/Haskell/Syntax/Extension.hs
@@ -387,6 +387,8 @@ type family XDo             x
 type family XExplicitList   x
 type family XRecordCon      x
 type family XRecordUpd      x
+type family XGetField       x
+type family XProjection     x
 type family XExprWithTySig  x
 type family XArithSeq       x
 type family XBracket        x
diff --git a/docs/users_guide/exts/hasfield.rst b/docs/users_guide/exts/hasfield.rst
index d83d3f15bd..5682c9f901 100644
--- a/docs/users_guide/exts/hasfield.rst
+++ b/docs/users_guide/exts/hasfield.rst
@@ -102,6 +102,8 @@ are generated for each datatype definition:
 
      instance (Eq a, a ~ b) => HasField "unSilly" (Silly a) b
 
+See :ref:`overloaded-record-dot` for an application of solving ``HasField`` constraints to implementing "record dot syntax".
+
 .. _virtual-record-fields:
 
 Virtual record fields
@@ -172,6 +174,3 @@ constraint will not be solved automatically (as described above), but in the
 interests of simplicity we do not permit users to define their own instances
 either.  If a field is not in scope, the corresponding instance is still
 prohibited, to avoid conflicts in downstream modules.
-
-
-
diff --git a/docs/users_guide/exts/overloaded_record_dot.rst b/docs/users_guide/exts/overloaded_record_dot.rst
new file mode 100644
index 0000000000..26f29b352c
--- /dev/null
+++ b/docs/users_guide/exts/overloaded_record_dot.rst
@@ -0,0 +1,34 @@
+.. _overloaded-record-dot:
+
+Overloaded record dot
+---------------------
+
+.. extension:: OverloadedRecordDot
+    :shortdesc: Record '.' syntax
+
+    :since: 9.2.0
+
+    Provides record '.' syntax e.g. ``x.foo``
+
+When ``OverloadedRecordDot`` is enabled one can write ``a.b`` to mean the ``b`` field of the ``a`` record expression.
+
+Example:
+
+.. code-block:: haskell
+
+  {-# LANGUAGE OverloadedRecordDot #-}
+  {-# LANGUAGE DuplicateRecordFields #-}
+
+  data Person = Person { name :: String }
+  data Company = Company { name :: String, owner :: Person }
+
+  main = do
+    let c = Company { name = "Acme Corp."
+                    , owner = Person { name = "Wile E. Coyote" } }
+    print $ c.name ++ " is run by " ++ c.owner.name
+
+You may also write ``(.b)`` to mean a function that "projects the ``b`` field from its argument". For example, ``(.b) a`` means the same thing as ``a.b``).
+
+``OverloadedRecordDot`` is normally implemented by desugaring record ``.`` expressions to ``GHC.Records.getField`` expressions. By enabling ``OverloadedRecordDot`` and ``RebindableSyntax`` together it is possible to desugar ``.`` expressions into your own ``getField`` implementations.
+
+When considering ``a.b``, the ``b`` field that is meant is determined by solving ``HasField`` constraints. See :ref:`solving-hasfield-constraints`.
diff --git a/docs/users_guide/exts/overloaded_record_update.rst b/docs/users_guide/exts/overloaded_record_update.rst
new file mode 100644
index 0000000000..2e9df747dc
--- /dev/null
+++ b/docs/users_guide/exts/overloaded_record_update.rst
@@ -0,0 +1,61 @@
+.. _overloaded-record-update:
+
+Overloaded record update
+------------------------
+
+.. extension:: OverloadedRecordUpdate
+    :shortdesc: Record '.' syntax record updates
+
+    :since: 9.2.0
+
+    Provides record '.' syntax in record updates e.g. ``x{foo.bar = 1}``.
+
+**EXPERIMENTAL**
+*This design of this extension may well change in the future. It would be inadvisable to start using this extension for long-lived libraries just yet.*
+
+It's usual (but not required) that this extension be used in conjunction with :ref:`overloaded-record-dot`.
+
+Example:
+
+.. code-block:: haskell
+
+  {-# LANGUAGE AllowAmbiguousTypes, FunctionalDependencies, ScopedTypeVariables, PolyKinds, TypeApplications, DataKinds, FlexibleInstances #-}
+  {-# LANGUAGE NamedFieldPuns, RecordWildCards #-}
+  {-# LANGUAGE OverloadedRecordDot, OverloadedRecordUpdate, RebindableSyntax #-}
+
+  import Prelude
+
+  class HasField x r a | x r -> a where
+    hasField :: r -> (a -> r, a)
+
+  getField :: forall x r a . HasField x r a => r -> a
+  getField = snd . hasField @x -- Note: a.x = is getField @"x" a.
+  setField :: forall x r a . HasField x r a => r -> a -> r
+  setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b.
+
+  data Person = Person { name :: String } deriving Show
+  instance HasField "name" Person String where
+      hasField r = (\x -> case r of Person { .. } -> Person { name = x, .. }, name r)
+
+  data Company = Company { company :: String, owner :: Person } deriving Show
+  instance HasField "company" Company String where
+      hasField r = (\x -> case r of Company { .. } -> Company { company = x, .. }, company r)
+  instance HasField "owner" Company Person where
+      hasField r = (\x -> case r of Company { .. } -> Company { owner = x, .. }, owner r)
+
+  main = do
+    let c = Company {company = "Acme Corp.", owner = Person { name = "Wile E. Coyote" }}
+
+    -- Top-level update
+    print $ c{company = "Acme United"} -- Company {company = "Acme United", owner = Person {name = "Wile E. Coyote"}}
+
+    -- Nested update
+    print $ c{owner.name = "Walter C. Johnsen"} -- Company {company = "Acme Corp.", owner = Person {name = "Walter C. Johnsen"}}
+
+    -- Punned update
+    let name = "Walter C. Johnsen"
+    print $ c{owner.name}  -- Company {company = "Acme Corp.", owner = Person {name = "Walter C. Johnsen"}}
+
+``OverloadedRecordUpdate`` works by desugaring record ``.`` update expressions to expressions involving the functions ``setField`` and ``getField``. Note that all record updates will be desugared to ``setField`` expressions whether they use ``.`` notation or not.
+
+At this time, ``RebindableSyntax`` must be enabled when ``OverloadedRecordUpdate`` is and users are required to provide definitions for ``getField`` and ``setField``. We anticipate this restriction to be lifted in a future release of GHC with builtin support for ``setField``.
diff --git a/docs/users_guide/exts/records.rst b/docs/users_guide/exts/records.rst
index 9395cf4666..b1e3f84a7c 100644
--- a/docs/users_guide/exts/records.rst
+++ b/docs/users_guide/exts/records.rst
@@ -14,3 +14,5 @@ Records
     record_puns
     record_wildcards
     hasfield
+    overloaded_record_dot
+    overloaded_record_update
diff --git a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
index a3c3e2edfe..b75977c74c 100644
--- a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
+++ b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
@@ -146,6 +146,8 @@ data Extension
    | StandaloneKindSignatures
    | LexicalNegation
    | FieldSelectors
+   | OverloadedRecordDot
+   | OverloadedRecordUpdate
    deriving (Eq, Enum, Show, Generic, Bounded)
 -- 'Ord' and 'Bounded' are provided for GHC API users (see discussions
 -- in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707 and
diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs
index 27be970d22..cbcbefc573 100644
--- a/testsuite/tests/driver/T4437.hs
+++ b/testsuite/tests/driver/T4437.hs
@@ -41,6 +41,8 @@ expectedGhcOnlyExtensions =
     , "AlternativeLayoutRule"
     , "AlternativeLayoutRuleTransitional"
     , "FieldSelectors"
+    , "OverloadedRecordDot"
+    , "OverloadedRecordUpdate"
     ]
 
 expectedCabalOnlyExtensions :: [String]
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxA.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxA.hs
new file mode 100644
index 0000000000..22b5aed888
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxA.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE AllowAmbiguousTypes, FunctionalDependencies, ScopedTypeVariables, PolyKinds, TypeApplications, DataKinds #-}
+{-# LANGUAGE RecordWildCards, OverloadedRecordDot, OverloadedRecordUpdate #-}
+
+module RecordDotSyntaxA where
+
+class HasField x r a | x r -> a where
+  hasField :: r -> (a -> r, a)
+
+getField :: forall x r a . HasField x r a => r -> a
+getField = snd . hasField @x -- Note: a.x = is getField @"x" a.
+
+setField :: forall x r a . HasField x r a => r -> a -> r
+setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b.
+
+data Foo = Foo {foo :: Int}
+instance HasField "foo" Foo Int where
+    hasField r = (\x -> case r of Foo { .. } -> Foo { foo = x, .. }, foo r)
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.hs
new file mode 100644
index 0000000000..f7692ec778
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+no = Foo { bar.baz = 1 }
+  -- Syntax error: Can't use '.' in construction.
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.stderr
new file mode 100644
index 0000000000..6e4a3fbae6
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.stderr
@@ -0,0 +1,2 @@
+ RecordDotSyntaxFail0.hs:3:12:
+    Use of OverloadedRecordDot '.' not valid ('.' isn't allowed when constructing records or in record patterns)
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.hs
new file mode 100644
index 0000000000..78b4f1072c
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+no Foo { bar.baz = x } = undefined
+  -- Syntax error: Field selector syntax doesn't participate
+  -- in patterns
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.stderr
new file mode 100644
index 0000000000..f1ab2b9f95
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.stderr
@@ -0,0 +1,2 @@
+RecordDotSyntaxFail1.hs:3:10:
+    Use of OverloadedRecordDot '.' not valid ('.' isn't allowed when constructing records or in record patterns)
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.hs
new file mode 100644
index 0000000000..cc76b469d5
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE AllowAmbiguousTypes, FunctionalDependencies, ScopedTypeVariables, PolyKinds, TypeApplications, DataKinds #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedRecordDot, OverloadedRecordUpdate #-}
+{-# LANGUAGE RebindableSyntax #-}
+import Prelude
+
+class HasField x r a | x r -> a where
+  hasField :: r -> (a -> r, a)
+
+getField :: forall x r a . HasField x r a => r -> a
+getField = snd . hasField @x -- Note: a.x = is getField @"x" a.
+
+setField :: forall x r a . HasField x r a => r -> a -> r
+setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b.
+
+-- 'Foo' has 'foo' field of type 'Bar'
+data Foo = Foo { foo :: Bar } deriving (Show, Eq)
+instance HasField "foo" Foo Bar where
+    hasField r = (\x -> case r of Foo { .. } -> Foo { foo = x, .. }, foo r)
+
+-- 'Bar' has a 'bar' field of type 'Baz'
+data Bar = Bar { bar :: Baz } deriving (Show, Eq)
+instance HasField "bar" Bar Baz where
+    hasField r = (\x -> case r of Bar { .. } -> Bar { bar = x, .. }, bar r)
+
+-- 'Baz' has a 'baz' field of type 'Quux'
+data Baz = Baz { baz :: Quux } deriving (Show, Eq)
+instance HasField "baz" Baz Quux where
+    hasField r = (\x -> case r of Baz { .. } -> Baz { baz = x, .. }, baz r)
+
+-- 'Quux' has a 'quux' field of type 'Int'
+data Quux = Quux { quux :: Int } deriving (Show, Eq)
+instance HasField "quux" Quux Int where
+    hasField r = (\x -> case r of Quux { .. } -> Quux { quux = x, .. }, quux r)
+
+main = do
+  let a = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 42 } } } }
+  let quux = "Expecto patronum!"
+  print $ a{foo.bar.baz.quux} -- Type error. Does a{foo.bar.baz.quux} get underlined?
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr
new file mode 100644
index 0000000000..38d9616489
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr
@@ -0,0 +1,13 @@
+RecordDotSyntaxFail10.hs:40:11:
+     Couldn't match type ‘Int’ with ‘[Char]’
+        arising from a functional dependency between:
+          constraint ‘HasField "quux" Quux String’
+            arising from a use of ‘setField’
+          instance ‘HasField "quux" Quux Int’
+            at RecordDotSyntaxFail10.hs:34:10-33
+     In the second argument of ‘($)’, namely ‘a {foo.bar.baz.quux}’
+      In a stmt of a 'do' block: print $ a {foo.bar.baz.quux}
+      In the expression:
+        do let a = ...
+           let quux = "Expecto patronum!"
+           print $ a {foo.bar.baz.quux}
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.hs
new file mode 100644
index 0000000000..62f9bd8f23
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+data Foo = Foo { foo :: Bar }
+data Bar = Bar { bar :: Int }
+
+main = do
+  let a = Foo { foo = Bar { bar = 1 }}
+  print $ (.foo.bar.baz) a -- Oops, what is baz?
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr
new file mode 100644
index 0000000000..4ca1005185
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr
@@ -0,0 +1,25 @@
+RecordDotSyntaxFail11.hs:8:3:
+     Ambiguous type variable ‘a0’ arising from a use of ‘print’
+      prevents the constraint ‘(Show a0)’ from being solved.
+      Probable fix: use a type annotation to specify what ‘a0’ should be.
+      These potential instances exist:
+        instance Show Ordering -- Defined in ‘GHC.Show’
+        instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’
+        instance Show Integer -- Defined in ‘GHC.Show’
+        ...plus 23 others
+        ...plus N instances involving out-of-scope types
+        (use -fprint-potential-instances to see them all)
+     In the first argument of ‘($)’, namely ‘print’
+      In a stmt of a 'do' block: print $ (foo.bar.baz) a
+      In the expression:
+        do let a = ...
+           print $ (foo.bar.baz) a
+
+RecordDotSyntaxFail11.hs:8:11:
+     No instance for (GHC.Records.HasField "baz" Int a0)
+        arising from a use of ‘GHC.Records.getField’
+     In the second argument of ‘($)’, namely ‘(foo.bar.baz) a’
+      In a stmt of a 'do' block: print $ (foo.bar.baz) a
+      In the expression:
+        do let a = ...
+           print $ (foo.bar.baz) a
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail12.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail12.hs
new file mode 100644
index 0000000000..ba7f7effed
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail12.hs
@@ -0,0 +1,140 @@
+{-# LANGUAGE AllowAmbiguousTypes, FunctionalDependencies, ScopedTypeVariables, PolyKinds, TypeApplications, DataKinds #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedRecordDot, OverloadedRecordUpdate #-}
+-- For "higher kinded data" test.
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+{-# LANGUAGE RebindableSyntax #-}
+import Prelude
+
+-- Choice (C2a).
+
+import Data.Function -- for &
+import Data.Functor.Identity
+
+class HasField x r a | x r -> a where
+  hasField :: r -> (a -> r, a)
+
+getField :: forall x r a . HasField x r a => r -> a
+getField = snd . hasField @x -- Note: a.x = is getField @"x" a.
+
+setField :: forall x r a . HasField x r a => r -> a -> r
+setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b.
+
+-- 'Foo' has 'foo' field of type 'Bar'
+data Foo = Foo { foo :: Bar } deriving (Show, Eq)
+instance HasField "foo" Foo Bar where
+    hasField r = (\x -> case r of Foo { .. } -> Foo { foo = x, .. }, foo r)
+
+-- 'Bar' has a 'bar' field of type 'Baz'
+data Bar = Bar { bar :: Baz } deriving (Show, Eq)
+instance HasField "bar" Bar Baz where
+    hasField r = (\x -> case r of Bar { .. } -> Bar { bar = x, .. }, bar r)
+
+-- 'Baz' has a 'baz' field of type 'Quux'
+data Baz = Baz { baz :: Quux } deriving (Show, Eq)
+instance HasField "baz" Baz Quux where
+    hasField r = (\x -> case r of Baz { .. } -> Baz { baz = x, .. }, baz r)
+
+-- 'Quux' has a 'quux' field of type 'Int'
+data Quux = Quux { quux :: Int } deriving (Show, Eq)
+instance HasField "quux" Quux Int where
+    hasField r = (\x -> case r of Quux { .. } -> Quux { quux = x, .. }, quux r)
+
+-- 'Corge' has a '&&&' field of type 'Int'
+data Corge = Corge { (&&&) :: Int } deriving (Show, Eq)
+instance HasField "&&&" Corge Int where
+    hasField r = (\x -> case r of Corge { .. } -> Corge { (&&&) = x, .. }, (&&&) r)
+-- Note : Dot notation is not available for fields with operator
+-- names.
+
+-- 'Grault' has two fields 'f' and 'g' of type 'Foo'.
+data Grault = Grault {f :: Foo, g :: Foo} deriving (Show, Eq)
+instance HasField "f" Grault Foo where
+    hasField r = (\x -> case r of Grault { .. } -> Grault { f = x, .. }, f r)
+instance HasField "g" Grault Foo where
+    hasField r = (\x -> case r of Grault { .. } -> Grault { g = x, .. }, g r)
+
+-- "Higher kinded data"
+-- (see https://reasonablypolymorphic.com/blog/higher-kinded-data/)
+type family H f a where
+  H Identity a = a
+  H f        a = f a
+data P f = P
+  { n :: H f String
+  }
+-- See https://github.com/ndmitchell/record-dot-preprocessor/pull/34.
+instance (a ~ H f String) => HasField "n" (P f) a where
+    hasField r = (\x -> case r of P { .. } -> P { n = x, .. }, n r)
+
+main = do
+  let a = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 42 } } } }
+  let b = Corge{ (&&&) = 12 };
+  let c = Grault {
+        f = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 1 } } } }
+      , g = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 1 } } } }
+       }
+
+  -- A "selector" is an expression like '(.a)' or '(.a.b)'.
+  putStrLn "-- selectors:"
+  print $ (.foo) a  -- Bar { bar = Baz { baz = Quux { quux = 42 } } }
+  print $ (.foo.bar) a -- Baz { baz = Quux { quux = 42 } }
+  print $ (.foo.bar.baz) a -- Quux { quux = 42 }
+  print $ (.foo.bar.baz.quux) a -- 42
+  print $ ((&&&) b) -- 12
+  -- print $ (b.(&&&)) -- illegal : parse error on input ‘(’
+  print $ getField @"&&&" b -- 12
+
+  -- A "selection" is an expression like 'r.a' or '(f r).a.b'.
+  putStrLn "-- selections:"
+  print $ a.foo.bar.baz.quux -- 42
+  print $ a.foo.bar.baz -- Quux { quux = 42 }
+  print $ a.foo.bar -- Baz { baz = Quux { quux = 42 } }
+  print $ a.foo -- Bar { bar = Baz { baz = Quux { quux = 42 } } }
+  print $ (const "hello") a.foo  -- f r.x means f (r.x)
+  -- print $ f a .foo  -- f r .x is illegal
+  print $ (const "hello") (id a).foo  -- f (g r).x means f ((g r).x)
+  -- print $ f (g a) .foo -- f (g r) .x is illegal
+  print $ a.foo
+            & (.bar.baz.quux) -- 42
+  print $ (a.foo
+               ).bar.baz.quux -- 42
+  print $ (+) a.foo.bar.baz.quux 1 -- 43
+  print $ (+) (id a).foo.bar.baz.quux 1 -- 43
+  print $ (+) ((id a).foo.bar & (.baz.quux)) 1 -- 43
+
+  -- An "update" is an expression like 'r{ a.b = 12 }'.
+  putStrLn "-- updates:"
+  print $ (a.foo.bar.baz) { quux = 2 } -- Quux { quux = 2 }
+  print $ (\b -> b{ bar=Baz{ baz=Quux{ quux=1 } } }) a.foo -- Bar { bar = Baz { baz = Quux { quux = 1 } } }
+  let bar = Bar { bar = Baz { baz = Quux { quux = 44 } } }
+  print $ a{ foo.bar = Baz { baz = Quux { quux = 44 } } } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 44 } } } }
+  print $ a{ foo.bar.baz = Quux { quux = 45 } } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 45 } } } }
+  print $ a{ foo.bar.baz.quux = 46 } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 46 } } } }
+  print $ c{ f.foo.bar.baz.quux = 3, g.foo.bar.baz.quux = 4 } -- Grault { f = Foo { foo = Bar { bar = Baz { baz = Quux { quux = 3 } } } }, g = Foo { foo = Bar { bar = Baz { baz = Quux { quux = 4 } } } } }
+
+  -- A "punned update" is an expression like 'r{ a.b }' (where it is
+  -- understood that 'b' is a variable binding in the environment of
+  -- the field update - enabled only when the extension
+  -- 'NamedFieldPuns' is in effect).
+  putStrLn "-- punned updates:"
+  let quux = 102; baz = Quux { quux }; bar = Baz { baz }; foo = Bar { bar } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } }
+  print $ a{ foo.bar.baz.quux } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } }
+  print $ a{ foo.bar.baz } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } }
+  print $ a{ foo.bar } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } }
+  print $ a{ foo } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } }
+  print $ a -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 42 } } } }
+  print $ c{ f.foo, g.foo.bar.baz.quux = 4 } -- Mix punned and explicit; 102, 4
+  f <- pure a
+  g <- pure a
+  print $ c{ f } -- 42, 1
+  print $ c{ f, g } -- 42, 42
+  print $ c{ f, g.foo.bar.baz.quux = 4 } -- Mix top-level and nested updates; 42, 4
+
+  putStrLn "-- misc:"
+  -- Higher kinded test.
+  let p = P { n = Just "me" } :: P Maybe
+  Just me <- pure p.n
+  putStrLn $ me
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail12.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail12.stderr
new file mode 100644
index 0000000000..6ef0a51754
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail12.stderr
@@ -0,0 +1,36 @@
+
+RecordDotSyntaxFail12.hs:123:25:
+    Illegal use of punning for field ‘quux’
+    Use NamedFieldPuns to permit this
+
+RecordDotSyntaxFail12.hs:123:46:
+    Illegal use of punning for field ‘baz’
+    Use NamedFieldPuns to permit this
+
+RecordDotSyntaxFail12.hs:123:65:
+    Illegal use of punning for field ‘bar’
+    Use NamedFieldPuns to permit this
+
+RecordDotSyntaxFail12.hs:124:11:
+    For this to work enable NamedFieldPuns.
+
+RecordDotSyntaxFail12.hs:125:11:
+    For this to work enable NamedFieldPuns.
+
+RecordDotSyntaxFail12.hs:126:11:
+    For this to work enable NamedFieldPuns.
+
+RecordDotSyntaxFail12.hs:127:11:
+    For this to work enable NamedFieldPuns.
+
+RecordDotSyntaxFail12.hs:129:11:
+    For this to work enable NamedFieldPuns.
+
+RecordDotSyntaxFail12.hs:132:11:
+    For this to work enable NamedFieldPuns.
+
+RecordDotSyntaxFail12.hs:133:11:
+    For this to work enable NamedFieldPuns.
+
+RecordDotSyntaxFail12.hs:134:11:
+    For this to work enable NamedFieldPuns.
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.hs
new file mode 100644
index 0000000000..7050145b9d
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE AllowAmbiguousTypes, FunctionalDependencies, ScopedTypeVariables, PolyKinds, TypeApplications, DataKinds #-}
+{-# LANGUAGE OverloadedRecordDot, OverloadedRecordUpdate #-}
+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RebindableSyntax #-}
+import Prelude
+
+class HasField x r a | x r -> a where
+  hasField :: r -> (a -> r, a)
+
+getField :: forall x r a . HasField x r a => r -> a
+getField = snd . hasField @x -- Note: a.x = is getField @"x" a.
+
+setField :: forall x r a . HasField x r a => r -> a -> r
+setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b.
+
+-- 'Foo' has 'foo' field of type 'Int'
+data Foo = Foo { foo :: Int } deriving (Show, Eq)
+instance HasField "foo" Foo Int where
+    hasField r = (\x -> case r of Foo { .. } -> Foo { foo = x, .. }, foo r)
+main = do
+  let a = Foo {foo = 12};
+  -- let foo = 13;
+  print $ a {foo}
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr
new file mode 100644
index 0000000000..8b5369731f
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr
@@ -0,0 +1,15 @@
+
+RecordDotSyntaxFail13.hs:26:11:
+     Couldn't match type ‘Int’ with ‘Foo -> Int’
+        arising from a functional dependency between:
+          constraint ‘HasField "foo" Foo (Foo -> Int)’
+            << This should not appear in error messages. If you see this
+            in an error message, please report a bug mentioning ‘record update’ at
+            https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug >>
+          instance ‘HasField "foo" Foo Int’
+            at RecordDotSyntaxFail13.hs:21:10-31
+     In the second argument of ‘($)’, namely ‘a {foo}’
+      In a stmt of a 'do' block: print $ a {foo}
+      In the expression:
+        do let a = ...
+           print $ a {foo}
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.hs
new file mode 100644
index 0000000000..39a3e0256b
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE OverloadedRecordDot #-} -- Enable '.'
+{-# LANGUAGE NoOverloadedRecordUpdate #-} -- Definitely not enable overloaded updates.
+
+data Foo = Foo { foo :: Bar }
+data Bar = Bar { bar :: Baz }
+data Baz = Baz { baz :: Quux }
+data Quux = Quux { quux :: Int }
+
+no :: Foo -> Foo
+no foo = foo { bar.baz = Quux { quux = 42 } } } }
+-- For this to work, OverloadedRecordUpdate must be enabled
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.stderr
new file mode 100644
index 0000000000..5430e37bc9
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.stderr
@@ -0,0 +1,2 @@
+RecordDotSyntaxFail2.hs:10:10:
+    OverloadedRecordUpdate needs to be enabled
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.hs
new file mode 100644
index 0000000000..ae1a1fa797
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE AllowAmbiguousTypes, FunctionalDependencies, ScopedTypeVariables, PolyKinds, TypeApplications, DataKinds #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+
+class HasField x r a | x r -> a where
+  hasField :: r -> (a -> r, a)
+
+getField :: forall x r a . HasField x r a => r -> a
+getField = snd . hasField @x -- Note: a.x = is getField @"x" a.
+
+setField :: forall x r a . HasField x r a => r -> a -> r
+setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b.
+
+-- 'Corge' has a '&&&' field of type 'Int'
+data Corge = Corge { (&&&) :: Int } deriving (Show, Eq)
+instance HasField "&&&" Corge Int where
+    hasField r = (\x -> case r of Corge { .. } -> Corge { (&&&) = x, .. }, (&&&) r)
+
+main = do
+  let b = Corge { (&&&) = 12 };
+  print $ (b.(&&&))
+   -- Syntax error: Dot notation is not available for fields with
+   -- operator names
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.stderr
new file mode 100644
index 0000000000..674b0c1e50
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.stderr
@@ -0,0 +1 @@
+RecordDotSyntaxFail3.hs:22:14: parse error on input ‘(’
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.hs
new file mode 100644
index 0000000000..b921cbc4b2
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+data Foo = Foo { foo :: Int }
+
+main = do
+  let a = Foo { foo = 1 }
+  print $ (const "hello") a .foo
+      -- Syntax error: f r .x is illegal.
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.stderr
new file mode 100644
index 0000000000..4ffc9df51e
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.stderr
@@ -0,0 +1,2 @@
+RecordDotSyntaxFail4.hs:7:29: error:
+    parse error on input ‘.’
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail5.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail5.hs
new file mode 100644
index 0000000000..c261a571b7
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail5.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE OverloadedRecordDot, OverloadedRecordUpdate #-}
+{-# LANGUAGE NoRebindableSyntax #-}
+
+data Foo = Foo { foo :: Bar } deriving (Show, Eq)
+data Bar = Bar { bar :: Baz } deriving (Show, Eq)
+data Baz = Baz { baz :: Quux } deriving (Show, Eq)
+data Quux = Quux { quux :: Int } deriving (Show, Eq)
+
+main = do
+  let a = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 42 } } } }
+
+   -- An "update" is an expression like 'r{ a.b = 12 }'.
+   --
+  -- We don't support these (in the case Rebindable Syntax is off) yet
+  -- (waiting on HasField support).
+  putStrLn "-- updates:"
+  print $ (a.foo.bar.baz) { quux = 2 } -- Quux { quux = 2 }
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail5.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail5.stderr
new file mode 100644
index 0000000000..efe360222c
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail5.stderr
@@ -0,0 +1,2 @@
+RecordDotSyntaxFail5.hs:17:11:
+ RebindableSyntax is required if OverloadedRecordUpdate is enabled.
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail6.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail6.hs
new file mode 100644
index 0000000000..8265f56914
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail6.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE OverloadedRecordDot, OverloadedRecordUpdate, RebindableSyntax #-}
+
+module Main where
+
+import qualified RecordDotSyntaxA as A
+
+main = do
+  let bar = A.Foo { A.foo =1 } -- A defn. Perfectly reasonable.
+  print $ A.foo bar -- Application of a selector. Also reasonable.
+  let baz = bar{A.foo = 2} -- An update with a qualified field; not supported!
+  print $ A.foo baz
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail6.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail6.stderr
new file mode 100644
index 0000000000..c53990475b
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail6.stderr
@@ -0,0 +1,5 @@
+[1 of 2] Compiling RecordDotSyntaxA ( RecordDotSyntaxA.hs, RecordDotSyntaxA.o )
+ [2 of 2] Compiling Main             ( RecordDotSyntaxFail6.hs, RecordDotSyntaxFail6.o )
+
+   RecordDotSyntaxFail6.hs:10:17:
+    Fields cannot be qualified when OverloadedRecordUpdate is enabled
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail7.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail7.hs
new file mode 100644
index 0000000000..0d3d92b431
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail7.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+module Main where
+
+import qualified RecordDotSyntaxA as A
+
+main = do
+  let bar = A.Foo { A.foo =1 } -- A defn. Perfectly reasonable.
+  print $ (bar.A.foo) -- A field selection where the field is qualified; parse error on input ‘A.foo’.
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail7.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail7.stderr
new file mode 100644
index 0000000000..feee41589f
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail7.stderr
@@ -0,0 +1,4 @@
+[1 of 2] Compiling RecordDotSyntaxA ( RecordDotSyntaxA.hs, RecordDotSyntaxA.o )
+[2 of 2] Compiling Main             ( RecordDotSyntaxFail7.hs, RecordDotSyntaxFail7.o )
+
+RecordDotSyntaxFail7.hs:9:16: parse error on input ‘A.foo’
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.hs
new file mode 100644
index 0000000000..3b6fcc97e2
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE OverloadedRecordDot, OverloadedRecordUpdate, RebindableSyntax#-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE AllowAmbiguousTypes, FunctionalDependencies, ScopedTypeVariables, PolyKinds, TypeApplications, DataKinds #-}
+
+import Prelude
+
+class HasField x r a | x r -> a where
+  hasField :: r -> (a -> r, a)
+
+getField :: forall x r a . HasField x r a => r -> a
+getField = snd . hasField @x -- Note: a.x = is getField @"x" a.
+
+setField :: forall x r a . HasField x r a => r -> a -> r
+setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b.
+
+-- 'Foo' has 'foo' field of type 'Bar'
+data Foo = Foo { foo :: Bar } deriving (Show, Eq)
+instance HasField "foo" Foo Bar where
+    hasField r = (\x -> case r of Foo { .. } -> Foo { foo = x, .. }, foo r)
+
+-- 'Bar' has a 'bar' field of type 'Baz'
+data Bar = Bar { bar :: Baz } deriving (Show, Eq)
+instance HasField "bar" Bar Baz where
+    hasField r = (\x -> case r of Bar { .. } -> Bar { bar = x, .. }, bar r)
+
+-- 'Baz' has a 'baz' field of type 'Quux'
+data Baz = Baz { baz :: Quux } deriving (Show, Eq)
+instance HasField "baz" Baz Quux where
+    hasField r = (\x -> case r of Baz { .. } -> Baz { baz = x, .. }, baz r)
+
+-- 'Quux' has a 'quux' field of type 'Int'
+data Quux = Quux { quux :: Int } deriving (Show, Eq)
+-- Forget to write this type's 'HasField' instance
+
+main = do
+  let a = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 42 } } } }
+  print $ a.foo.bar.baz.quux
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr
new file mode 100644
index 0000000000..8bf921b79f
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr
@@ -0,0 +1,25 @@
+RecordDotSyntaxFail8.hs:37:3:
+     Ambiguous type variable ‘a0’ arising from a use of ‘print’
+      prevents the constraint ‘(Show a0)’ from being solved.
+      Probable fix: use a type annotation to specify what ‘a0’ should be.
+      These potential instances exist:
+        instance Show Ordering -- Defined in ‘GHC.Show’
+        instance Show Bar -- Defined at RecordDotSyntaxFail8.hs:22:41
+        instance Show Baz -- Defined at RecordDotSyntaxFail8.hs:27:42
+        ...plus 27 others
+        ...plus N instances involving out-of-scope types
+        (use -fprint-potential-instances to see them all)
+     In the first argument of ‘($)’, namely ‘print’
+      In a stmt of a 'do' block: print $ ....baz.quux
+      In the expression:
+        do let a = ...
+           print $ ....quux
+
+RecordDotSyntaxFail8.hs:37:11:
+     No instance for (HasField "quux" Quux a0)
+        arising from selecting the field ‘quux’
+     In the second argument of ‘($)’, namely ‘....baz.quux’
+      In a stmt of a 'do' block: print $ ....baz.quux
+      In the expression:
+        do let a = ...
+           print $ ....quux
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.hs b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.hs
new file mode 100644
index 0000000000..b262215215
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+data Foo = Foo { foo :: Int } deriving Show
+
+main = do
+  let a = Foo { foo = 42 }
+  let _ = a.foo :: String -- Type error. Does a.foo get underlined?
+  undefined
diff --git a/testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.stderr b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.stderr
new file mode 100644
index 0000000000..ee15f9fc6b
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.stderr
@@ -0,0 +1,9 @@
+RecordDotSyntaxFail9.hs:7:11:
+     Couldn't match type ‘Int’ with ‘[Char]’
+        arising from selecting the field ‘foo’
+     In the expression: a.foo :: String
+      In a pattern binding: _ = a.foo :: String
+      In the expression:
+        do let a = ...
+           let _ = ...
+           undefined
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index 88a37ec2ba..21d66337e9 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -175,3 +175,17 @@ test('T18251e', normal, compile_fail, [''])
 test('T18251f', normal, compile_fail, [''])
 test('T12446', normal, compile_fail, [''])
 test('T17045', normal, compile_fail, [''])
+test('RecordDotSyntaxFail0', normal, compile_fail, [''])
+test('RecordDotSyntaxFail1', normal, compile_fail, [''])
+test('RecordDotSyntaxFail2', normal, compile_fail, [''])
+test('RecordDotSyntaxFail3', normal, compile_fail, [''])
+test('RecordDotSyntaxFail4', normal, compile_fail, [''])
+test('RecordDotSyntaxFail5', normal, compile_fail, [''])
+test('RecordDotSyntaxFail6', [extra_files(['RecordDotSyntaxA.hs'])], multimod_compile_fail, ['RecordDotSyntaxFail6', ''])
+test('RecordDotSyntaxFail7', [extra_files(['RecordDotSyntaxA.hs'])], multimod_compile_fail, ['RecordDotSyntaxFail7', ''])
+test('RecordDotSyntaxFail8', normal, compile_fail, [''])
+test('RecordDotSyntaxFail9', normal, compile_fail, [''])
+test('RecordDotSyntaxFail10', normal, compile_fail, [''])
+test('RecordDotSyntaxFail11', normal, compile_fail, [''])
+test('RecordDotSyntaxFail12', normal, compile_fail, [''])
+test('RecordDotSyntaxFail13', normal, compile_fail, [''])
diff --git a/testsuite/tests/parser/should_run/RecordDotSyntax1.hs b/testsuite/tests/parser/should_run/RecordDotSyntax1.hs
new file mode 100644
index 0000000000..2d14218f83
--- /dev/null
+++ b/testsuite/tests/parser/should_run/RecordDotSyntax1.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE AllowAmbiguousTypes, FunctionalDependencies, ScopedTypeVariables, PolyKinds, TypeApplications, DataKinds #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedRecordDot, OverloadedRecordUpdate #-}
+-- For "higher kinded data" test.
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+{-# LANGUAGE RebindableSyntax #-}
+import Prelude
+
+-- Choice (C2a).
+
+import Data.Function -- for &
+import Data.Functor.Identity
+
+class HasField x r a | x r -> a where
+  hasField :: r -> (a -> r, a)
+
+getField :: forall x r a . HasField x r a => r -> a
+getField = snd . hasField @x -- Note: a.x = is getField @"x" a.
+
+setField :: forall x r a . HasField x r a => r -> a -> r
+setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b.
+
+-- 'Foo' has 'foo' field of type 'Bar'
+data Foo = Foo { foo :: Bar } deriving (Show, Eq)
+instance HasField "foo" Foo Bar where
+    hasField r = (\x -> case r of Foo { .. } -> Foo { foo = x, .. }, foo r)
+
+-- 'Bar' has a 'bar' field of type 'Baz'
+data Bar = Bar { bar :: Baz } deriving (Show, Eq)
+instance HasField "bar" Bar Baz where
+    hasField r = (\x -> case r of Bar { .. } -> Bar { bar = x, .. }, bar r)
+
+-- 'Baz' has a 'baz' field of type 'Quux'
+data Baz = Baz { baz :: Quux } deriving (Show, Eq)
+instance HasField "baz" Baz Quux where
+    hasField r = (\x -> case r of Baz { .. } -> Baz { baz = x, .. }, baz r)
+
+-- 'Quux' has a 'quux' field of type 'Int'
+data Quux = Quux { quux :: Int } deriving (Show, Eq)
+instance HasField "quux" Quux Int where
+    hasField r = (\x -> case r of Quux { .. } -> Quux { quux = x, .. }, quux r)
+
+-- 'Corge' has a '&&&' field of type 'Int'
+data Corge = Corge { (&&&) :: Int } deriving (Show, Eq)
+instance HasField "&&&" Corge Int where
+    hasField r = (\x -> case r of Corge { .. } -> Corge { (&&&) = x, .. }, (&&&) r)
+-- Note : Dot notation is not available for fields with operator
+-- names.
+
+-- 'Grault' has two fields 'f' and 'g' of type 'Foo'.
+data Grault = Grault {f :: Foo, g :: Foo} deriving (Show, Eq)
+instance HasField "f" Grault Foo where
+    hasField r = (\x -> case r of Grault { .. } -> Grault { f = x, .. }, f r)
+instance HasField "g" Grault Foo where
+    hasField r = (\x -> case r of Grault { .. } -> Grault { g = x, .. }, g r)
+
+-- "Higher kinded data"
+-- (see https://reasonablypolymorphic.com/blog/higher-kinded-data/)
+type family H f a where
+  H Identity a = a
+  H f        a = f a
+data P f = P
+  { n :: H f String
+  }
+-- See https://github.com/ndmitchell/record-dot-preprocessor/pull/34.
+instance (a ~ H f String) => HasField "n" (P f) a where
+    hasField r = (\x -> case r of P { .. } -> P { n = x, .. }, n r)
+
+main = do
+  let a = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 42 } } } }
+  let b = Corge{ (&&&) = 12 };
+  let c = Grault {
+        f = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 1 } } } }
+      , g = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 1 } } } }
+       }
+
+  -- A "selector" is an expression like '(.a)' or '(.a.b)'.
+  putStrLn "-- selectors:"
+  print $ (.foo) a  -- Bar { bar = Baz { baz = Quux { quux = 42 } } }
+  print $ (.foo.bar) a -- Baz { baz = Quux { quux = 42 } }
+  print $ (.foo.bar.baz) a -- Quux { quux = 42 }
+  print $ (.foo.bar.baz.quux) a -- 42
+  print $ ((&&&) b) -- 12
+  -- print $ (b.(&&&)) -- illegal : parse error on input ‘(’
+  print $ getField @"&&&" b -- 12
+
+  -- A "selection" is an expression like 'r.a' or '(f r).a.b'.
+  putStrLn "-- selections:"
+  print $ a.foo.bar.baz.quux -- 42
+  print $ a.foo.bar.baz -- Quux { quux = 42 }
+  print $ a.foo.bar -- Baz { baz = Quux { quux = 42 } }
+  print $ a.foo -- Bar { bar = Baz { baz = Quux { quux = 42 } } }
+  print $ (const "hello") a.foo  -- f r.x means f (r.x)
+  -- print $ f a .foo  -- f r .x is illegal
+  print $ (const "hello") (id a).foo  -- f (g r).x means f ((g r).x)
+  -- print $ f (g a) .foo -- f (g r) .x is illegal
+  print $ a.foo
+            & (.bar.baz.quux) -- 42
+  print $ (a.foo
+               ).bar.baz.quux -- 42
+  print $ (+) a.foo.bar.baz.quux 1 -- 43
+  print $ (+) (id a).foo.bar.baz.quux 1 -- 43
+  print $ (+) ((id a).foo.bar & (.baz.quux)) 1 -- 43
+
+  -- An "update" is an expression like 'r{ a.b = 12 }'.
+  putStrLn "-- updates:"
+  print $ (a.foo.bar.baz) { quux = 2 } -- Quux { quux = 2 }
+  print $ (\b -> b{ bar=Baz{ baz=Quux{ quux=1 } } }) a.foo -- Bar { bar = Baz { baz = Quux { quux = 1 } } }
+  let bar = Bar { bar = Baz { baz = Quux { quux = 44 } } }
+  print $ a{ foo.bar = Baz { baz = Quux { quux = 44 } } } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 44 } } } }
+  print $ a{ foo.bar.baz = Quux { quux = 45 } } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 45 } } } }
+  print $ a{ foo.bar.baz.quux = 46 } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 46 } } } }
+  print $ c{ f.foo.bar.baz.quux = 3, g.foo.bar.baz.quux = 4 } -- Grault { f = Foo { foo = Bar { bar = Baz { baz = Quux { quux = 3 } } } }, g = Foo { foo = Bar { bar = Baz { baz = Quux { quux = 4 } } } } }
+
+  -- A "punned update" is an expression like 'r{ a.b }' (where it is
+  -- understood that 'b' is a variable binding in the environment of
+  -- the field update - enabled only when the extension
+  -- 'NamedFieldPuns' is in effect).
+  putStrLn "-- punned updates:"
+  let quux = 102; baz = Quux { quux }; bar = Baz { baz }; foo = Bar { bar } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } }
+  print $ a{ foo.bar.baz.quux } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } }
+  print $ a{ foo.bar.baz } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } }
+  print $ a{ foo.bar } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } }
+  print $ a{ foo } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } }
+  print $ a -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 42 } } } }
+  print $ c{ f.foo, g.foo.bar.baz.quux = 4 } -- Mix punned and explicit; 102, 4
+  f <- pure a
+  g <- pure a
+  print $ c{ f } -- 42, 1
+  print $ c{ f, g } -- 42, 42
+  print $ c{ f, g.foo.bar.baz.quux = 4 } -- Mix top-level and nested updates; 42, 4
+
+  putStrLn "-- misc:"
+  -- Higher kinded test.
+  let p = P { n = Just "me" } :: P Maybe
+  Just me <- pure p.n
+  putStrLn $ me
diff --git a/testsuite/tests/parser/should_run/RecordDotSyntax1.stdout b/testsuite/tests/parser/should_run/RecordDotSyntax1.stdout
new file mode 100644
index 0000000000..9582e17da9
--- /dev/null
+++ b/testsuite/tests/parser/should_run/RecordDotSyntax1.stdout
@@ -0,0 +1,38 @@
+-- selectors:
+Bar {bar = Baz {baz = Quux {quux = 42}}}
+Baz {baz = Quux {quux = 42}}
+Quux {quux = 42}
+42
+12
+12
+-- selections:
+42
+Quux {quux = 42}
+Baz {baz = Quux {quux = 42}}
+Bar {bar = Baz {baz = Quux {quux = 42}}}
+"hello"
+"hello"
+42
+42
+43
+43
+43
+-- updates:
+Quux {quux = 2}
+Bar {bar = Baz {baz = Quux {quux = 1}}}
+Foo {foo = Bar {bar = Baz {baz = Quux {quux = 44}}}}
+Foo {foo = Bar {bar = Baz {baz = Quux {quux = 45}}}}
+Foo {foo = Bar {bar = Baz {baz = Quux {quux = 46}}}}
+Grault {f = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 3}}}}, g = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 4}}}}}
+-- punned updates:
+Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}}
+Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}}
+Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}}
+Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}}
+Foo {foo = Bar {bar = Baz {baz = Quux {quux = 42}}}}
+Grault {f = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}}, g = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 4}}}}}
+Grault {f = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 42}}}}, g = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 1}}}}}
+Grault {f = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 42}}}}, g = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 42}}}}}
+Grault {f = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 42}}}}, g = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 4}}}}}
+-- misc:
+me
diff --git a/testsuite/tests/parser/should_run/RecordDotSyntax2.hs b/testsuite/tests/parser/should_run/RecordDotSyntax2.hs
new file mode 100644
index 0000000000..89c520009f
--- /dev/null
+++ b/testsuite/tests/parser/should_run/RecordDotSyntax2.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE NoRebindableSyntax #-}
+
+data Foo = Foo { foo :: Bar } deriving (Show, Eq)
+data Bar = Bar { bar :: Baz } deriving (Show, Eq)
+data Baz = Baz { baz :: Quux } deriving (Show, Eq)
+data Quux = Quux { quux :: Int } deriving (Show, Eq)
+
+main = do
+  let a = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 42 } } } }
+
+  -- A "selector" is an expression like '(.a)' or '(.a.b)'.
+  putStrLn "-- selectors:"
+  print $ (.foo) a  -- Bar { bar = Baz { baz = Quux { quux = 42 } } }
+  print $ (.foo.bar) a -- Baz { baz = Quux { quux = 42 } }
+  print $ (.foo.bar.baz) a -- Quux { quux = 42 }
+  print $ (.foo.bar.baz.quux) a -- 42
+
+  -- A "selection" is an expression like 'r.a' or '(f r).a.b'.
+  putStrLn "-- selections:"
+  print $ a.foo.bar.baz.quux -- 42
+  print $ a.foo.bar.baz -- Quux { quux = 42 }
+  print $ a.foo.bar -- Baz { baz = Quux { quux = 42 } }
+  print $ a.foo -- Bar { bar = Baz { baz = Quux { quux = 42 } } }
+
+  -- An "update" is an expression like 'r{ a.b = 12 }'.
+  --
+  -- We don't support these (in the case Rebindable Syntax is off) yet
+  -- (waiting on HasField support).
+  --
+  -- Regular updates are fine though!
+  print $ a{foo=(foo a){bar = (bar (foo a)){baz = (baz (bar (foo a))){quux = quux (baz (bar (foo a))) + 1}}}}
+  print $ a{foo=(a.foo){bar = (a.foo.bar){baz = (a.foo.bar.baz){quux = a.foo.bar.baz.quux + 1}}}}
diff --git a/testsuite/tests/parser/should_run/RecordDotSyntax2.stdout b/testsuite/tests/parser/should_run/RecordDotSyntax2.stdout
new file mode 100644
index 0000000000..6755663e6a
--- /dev/null
+++ b/testsuite/tests/parser/should_run/RecordDotSyntax2.stdout
@@ -0,0 +1,12 @@
+-- selectors:
+Bar {bar = Baz {baz = Quux {quux = 42}}}
+Baz {baz = Quux {quux = 42}}
+Quux {quux = 42}
+42
+-- selections:
+42
+Quux {quux = 42}
+Baz {baz = Quux {quux = 42}}
+Bar {bar = Baz {baz = Quux {quux = 42}}}
+Foo {foo = Bar {bar = Baz {baz = Quux {quux = 43}}}}
+Foo {foo = Bar {bar = Baz {baz = Quux {quux = 43}}}}
diff --git a/testsuite/tests/parser/should_run/RecordDotSyntax3.hs b/testsuite/tests/parser/should_run/RecordDotSyntax3.hs
new file mode 100644
index 0000000000..1ee7565573
--- /dev/null
+++ b/testsuite/tests/parser/should_run/RecordDotSyntax3.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+module Main where
+
+import qualified RecordDotSyntaxA as A
+
+
+main = do
+  print $ id A.n -- Foo {foo = 2}; f M.x means f (M.x)
+  print $ id A.n.foo -- 2; f M.n.x means f (M.n.x)
+
+  let bar = A.Foo {A.foo = 1}
+  print $ bar.foo -- Ok; 1
+  -- print $ bar.A.foo -- parse error on input 'A.foo'
diff --git a/testsuite/tests/parser/should_run/RecordDotSyntax3.stdout b/testsuite/tests/parser/should_run/RecordDotSyntax3.stdout
new file mode 100644
index 0000000000..0de59d2464
--- /dev/null
+++ b/testsuite/tests/parser/should_run/RecordDotSyntax3.stdout
@@ -0,0 +1,3 @@
+Foo {foo = 2}
+2
+1
diff --git a/testsuite/tests/parser/should_run/RecordDotSyntax4.hs b/testsuite/tests/parser/should_run/RecordDotSyntax4.hs
new file mode 100644
index 0000000000..924ed03bde
--- /dev/null
+++ b/testsuite/tests/parser/should_run/RecordDotSyntax4.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+module Main where
+
+import qualified RecordDotSyntaxA as A
+
+main = do
+  let bar = A.Foo {A.foo = 1}
+  print $ bar{A.foo = 2} -- Qualified labels ok in regular updates.
diff --git a/testsuite/tests/parser/should_run/RecordDotSyntax4.stdout b/testsuite/tests/parser/should_run/RecordDotSyntax4.stdout
new file mode 100644
index 0000000000..43c812f394
--- /dev/null
+++ b/testsuite/tests/parser/should_run/RecordDotSyntax4.stdout
@@ -0,0 +1 @@
+Foo {foo = 2}
diff --git a/testsuite/tests/parser/should_run/RecordDotSyntaxA.hs b/testsuite/tests/parser/should_run/RecordDotSyntaxA.hs
new file mode 100644
index 0000000000..907d6a23f6
--- /dev/null
+++ b/testsuite/tests/parser/should_run/RecordDotSyntaxA.hs
@@ -0,0 +1,6 @@
+module RecordDotSyntaxA where
+
+data Foo = Foo { foo :: Int } deriving Show
+
+n :: Foo
+n = Foo {foo = 2}
diff --git a/testsuite/tests/parser/should_run/all.T b/testsuite/tests/parser/should_run/all.T
index 064ef8fffd..caf0e2bc65 100644
--- a/testsuite/tests/parser/should_run/all.T
+++ b/testsuite/tests/parser/should_run/all.T
@@ -23,3 +23,7 @@ test('CountParserDeps',
      compile_and_run,
      ['-package ghc'])
 test('LexNegLit', normal, compile_and_run, [''])
+test('RecordDotSyntax1', normal, compile_and_run, [''])
+test('RecordDotSyntax2', normal, compile_and_run, [''])
+test('RecordDotSyntax3', [extra_files(['RecordDotSyntaxA.hs'])], multimod_compile_and_run, ['RecordDotSyntax3', ''])
+test('RecordDotSyntax4', [extra_files(['RecordDotSyntaxA.hs'])], multimod_compile_and_run, ['RecordDotSyntax4', ''])
diff --git a/utils/haddock b/utils/haddock
-Subproject 8241d9e700e043b86b609c334494c4632848389
+Subproject 0bf811ba98af90f852066734977aacb898ba8e6