Remove Either from RecordUpdwip/T18599-rec-update-rep-nonempty

14 files changed, 203 insertions, 128 deletions

diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 703f24ffb3..566596d551 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -45,6 +45,7 @@ import GHC.Hs.Binds
 -- others:
 import GHC.Tc.Types.Evidence
 import GHC.Types.Name
+import GHC.Types.Name.Reader
 import GHC.Types.Name.Set
 import GHC.Types.Basic
 import GHC.Types.Fixity
@@ -62,6 +63,7 @@ import GHC.Tc.Utils.TcType (TcType)
 import {-# SOURCE #-} GHC.Tc.Types (TcLclEnv)
 
 -- libraries:
+import qualified Data.List.NonEmpty as NE
 import Data.Data hiding (Fixity(..))
 import qualified Data.Data as Data (Fixity(..))
 import qualified Data.Kind
@@ -522,9 +524,12 @@ ppr_expr (RecordCon { rcon_con = con, rcon_flds = rbinds })
                GhcTc -> ppr con
 
 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))))
+  = hang (ppr aexp) 2 (braces (fsep (punctuate comma (map print_update flds))))
+  where
+    print_update (L _ u) =
+      let flds = map fieldName (NE.toList (unLoc $ hsRecFieldLbl u)) in
+      hcat (punctuate dot (map ppr flds))
+    fieldName f = occNameFS (rdrNameOcc (rdrNameAmbiguousFieldOcc f))
 
 ppr_expr (HsGetField { gf_expr = L _ fexp, gf_field = field })
   = ppr fexp <> dot <> ppr field
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index 2a81beaeb9..0c5fbae3cb 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -34,7 +34,7 @@ module GHC.Hs.Pat (
         HsRecField, LHsRecField,
         HsRecUpdField, LHsRecUpdField,
         hsRecFields, hsRecFieldSel, hsRecFieldId, hsRecFieldsArgs,
-        hsRecUpdFieldId, hsRecUpdFieldOcc, hsRecUpdFieldRdr,
+        hsRecUpdFieldId, hsRecUpdFieldId', hsRecUpdFieldOcc, hsRecUpdFieldOcc', hsRecUpdFieldRdr,
 
         mkPrefixConPat, mkCharLitPat, mkNilPat,
 
@@ -74,6 +74,7 @@ import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Core.TyCon
 import GHC.Utils.Outputable
+import GHC.Utils.Panic
 import GHC.Core.Type
 import GHC.Types.SrcLoc
 import GHC.Data.Bag -- collect ev vars from pats
@@ -81,7 +82,8 @@ import GHC.Data.Maybe
 import GHC.Types.Name (Name)
 import GHC.Driver.Session
 import qualified GHC.LanguageExtensions as LangExt
-
+import Data.List.NonEmpty(NonEmpty(..))
+import qualified Data.List.NonEmpty as NonEmpty
 
 data ListPatTc
   = ListPatTc
@@ -197,14 +199,39 @@ hsRecFieldId :: HsRecField GhcTc arg -> Located Id
 hsRecFieldId = hsRecFieldSel
 
 hsRecUpdFieldRdr :: HsRecUpdField (GhcPass p) -> Located RdrName
-hsRecUpdFieldRdr = fmap rdrNameAmbiguousFieldOcc . hsRecFieldLbl
+hsRecUpdFieldRdr upd =
+  -- In this context hsRecFieldLbl can only ever contain a singleton
+  -- list of FieldOccs.
+  let (L l fieldOccs) = hsRecFieldLbl upd
+      fieldOcc = NonEmpty.head fieldOccs in
+  L l (rdrNameAmbiguousFieldOcc fieldOcc)
 
 hsRecUpdFieldId :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> Located Id
 hsRecUpdFieldId = fmap extFieldOcc . hsRecUpdFieldOcc
 
+hsRecUpdFieldId' :: HsRecField' (NonEmpty (AmbiguousFieldOcc GhcTc)) arg -> Located Id
+hsRecUpdFieldId' fld =
+  let L l fieldOccs = hsRecUpdFieldOcc' fld
+      fieldOcc = NonEmpty.head fieldOccs
+  in L l (extFieldOcc fieldOcc)
+
 hsRecUpdFieldOcc :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
 hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl
 
+hsRecUpdFieldOcc' :: HsRecField' (NonEmpty (AmbiguousFieldOcc GhcTc)) arg -> Located (NonEmpty (FieldOcc GhcTc))
+hsRecUpdFieldOcc' fld =
+  let L l fieldOccs = hsRecFieldLbl fld
+      fieldOcc = NonEmpty.head fieldOccs
+   in L l ((unambiguousFieldOcc fieldOcc) :| [])
+
+{-
+hsRecUpdFieldOcc' :: HsRecField' (NonEmpty (AmbiguousFieldOcc GhcTc)) arg -> Located (NonEmpty (FieldOcc GhcTc))
+hsRecUpdFieldOcc' fld =
+   case hsRecFieldLbl fld of
+     L l (fieldOcc :| []) -> L l ((unambiguousFieldOcc fieldOcc) :| [])
+     _ -> panic "hsRecUpdFieldOcc': The impossible happened!"
+-}
+
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 18a9a703b0..354b738c62 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -594,14 +594,10 @@ 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 = Left flds })
+addTickHsExpr expr@(RecordUpd { rupd_expr = e, rupd_flds = flds })
   = do { e' <- addTickLHsExpr e
        ; flds' <- mapM addTickHsRecField 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' }) }
+       ; return (expr { rupd_expr = e', rupd_flds = flds' }) }
 
 addTickHsExpr (ExprWithTySig x e ty) =
         liftM3 ExprWithTySig
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 387963827e..aa0c69cd4c 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -606,11 +606,7 @@ we want, namely
 
 -}
 
-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
+dsExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields
                        , rupd_ext = RecordUpdTc
                            { rupd_cons = cons_to_upd
                            , rupd_in_tys = in_inst_tys
@@ -650,7 +646,7 @@ dsExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = Left fields
       -- Hence 'lcl_id'.  Cf #2735
     ds_field (L _ rec_field)
       = do { rhs <- dsLExpr (hsRecFieldArg rec_field)
-           ; let fld_id = unLoc (hsRecUpdFieldId rec_field)
+           ; let fld_id = unLoc (hsRecUpdFieldId' rec_field)
            ; lcl_id <- newSysLocalDs (idMult fld_id) (idType fld_id)
            ; return (idName fld_id, lcl_id, rhs) }
 
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 29b9da99f5..d4aba5078e 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -92,6 +92,7 @@ import qualified GHC.LanguageExtensions as LangExt
 import Data.ByteString ( unpack )
 import Control.Monad
 import Data.List (sort, sortBy)
+import qualified Data.List.NonEmpty as NE
 import Data.Function
 import Control.Monad.Trans.Reader
 import Control.Monad.Trans.Class
@@ -1580,15 +1581,10 @@ 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 = Left flds })
+repE (RecordUpd { rupd_expr = e, rupd_flds = 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) $
@@ -1715,7 +1711,7 @@ repUpdFields :: [LHsRecUpdField GhcRn] -> MetaM (Core [M TH.FieldExp])
 repUpdFields = repListM fieldExpTyConName rep_fld
   where
     rep_fld :: LHsRecUpdField GhcRn -> MetaM (Core (M TH.FieldExp))
-    rep_fld (L l fld) = case unLoc (hsRecFieldLbl fld) of
+    rep_fld (L l fld) = case NE.head (unLoc (hsRecFieldLbl fld)) of
       Unambiguous sel_name _ -> do { fn <- lookupLOcc (L l sel_name)
                                    ; e  <- repLE (hsRecFieldArg fld)
                                    ; repFieldExp fn e }
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index f33c64a4b2..ee9604a4d0 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -71,6 +71,8 @@ import qualified Data.Array as A
 import qualified Data.ByteString as BS
 import qualified Data.Map as M
 import qualified Data.Set as S
+import qualified Data.List.NonEmpty as NE
+import Data.List.NonEmpty ( NonEmpty(..) )
 import Data.Data                  ( Data, Typeable )
 import Data.Void                  ( Void, absurd )
 import Control.Monad              ( forM_ )
@@ -778,6 +780,8 @@ class ( IsPass p
       , ToHie (Context (Located (IdGhcP p)))
       , ToHie (RFContext (Located (AmbiguousFieldOcc (GhcPass p))))
       , ToHie (RFContext (Located (FieldOcc (GhcPass p))))
+      , ToHie (RFContext (Located (NonEmpty (AmbiguousFieldOcc (GhcPass p)))))
+      , ToHie (RFContext (Located (NonEmpty (FieldOcc (GhcPass p)))))
       , ToHie (TScoped (LHsWcType (GhcPass (NoGhcTcPass p))))
       , ToHie (TScoped (LHsSigWcType (GhcPass (NoGhcTcPass p))))
       )
@@ -1118,13 +1122,10 @@ 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 = Left upds}->
+      RecordUpd { rupd_expr = expr, rupd_flds = 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
@@ -1303,6 +1304,35 @@ instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where
       [ toHie $ C (RecField c rhs) (L nspan var)
       ]
 
+instance ToHie (RFContext (Located (NonEmpty (FieldOcc GhcRn)))) where
+  toHie (RFC c rhs (L nspan f)) = concatM $ case (NE.head f) of
+    FieldOcc name _ ->
+      [ toHie $ C (RecField c rhs) (L nspan name)
+      ]
+
+instance ToHie (RFContext (Located (NonEmpty (FieldOcc GhcTc)))) where
+  toHie (RFC c rhs (L nspan f)) = concatM $ case (NE.head f) of
+    FieldOcc var _ ->
+      [ toHie $ C (RecField c rhs) (L nspan var)
+      ]
+
+instance ToHie (RFContext (Located (NonEmpty (AmbiguousFieldOcc GhcRn)))) where
+  toHie (RFC c rhs (L nspan afo)) = concatM $ case (NE.head afo) of
+    Unambiguous name _ ->
+      [ toHie $ C (RecField c rhs) $ L nspan name
+      ]
+    Ambiguous _name _ ->
+      [ ]
+
+instance ToHie (RFContext (Located (NonEmpty (AmbiguousFieldOcc GhcTc)))) where
+  toHie (RFC c rhs (L nspan afo)) = concatM $ case (NE.head afo) of
+    Unambiguous var _ ->
+      [ toHie $ C (RecField c rhs) (L nspan var)
+      ]
+    Ambiguous var _ ->
+      [ toHie $ C (RecField c rhs) (L nspan var)
+      ]
+
 instance HiePass p => ToHie (RScoped (ApplicativeArg (GhcPass p))) where
   toHie (RS sc (ApplicativeArgOne _ pat expr _)) = concatM
     [ toHie $ PS Nothing sc NoScope pat
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 7f63bae941..ab6a6487e8 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -139,6 +139,8 @@ import GHC.Utils.Misc
 import GHC.Parser.Annotation
 import Data.Either
 import Data.List
+import Data.List.NonEmpty( NonEmpty(..) )
+import qualified Data.List.NonEmpty as NE
 import Data.Foldable
 import GHC.Driver.Flags ( WarningFlag(..) )
 import GHC.Utils.Panic
@@ -2187,10 +2189,10 @@ mkRdrRecordUpd overloaded_on exp@(L loc _) fbinds = do
       return RecordUpd {
         rupd_ext = noExtField
       , rupd_expr = exp
-      , rupd_flds = Left fs' }
+      , rupd_flds = fs' }
     True -> do
       let qualifiedFields =
-            [ L l lbl | L _ (HsRecField (L l lbl) _ _) <- fs'
+            [ L l lbl | L _ (HsRecField (L l (lbl :| [])) _ _) <- fs'
                       , isQual . rdrNameAmbiguousFieldOcc $ lbl
             ]
       if not $ null qualifiedFields
@@ -2198,16 +2200,29 @@ mkRdrRecordUpd overloaded_on exp@(L loc _) fbinds = do
           addFatalError $ PsError PsErrOverloadedRecordUpdateNoQualifiedFields [] (getLoc (head qualifiedFields))
         else -- This is a RecordDotSyntax update.
           return RecordUpd {
-            rupd_ext = noExtField
+             rupd_ext = noExtField
            , rupd_expr = exp
-           , rupd_flds = Right (toProjUpdates fbinds) }
+           , rupd_flds = toProjUpdates fbinds }
   where
 
-    toProjUpdates :: [Fbind (HsExpr GhcPs)] -> [LHsRecUpdProj GhcPs]
-    toProjUpdates =
-      map (\case { Right p -> p
-                 ; Left f -> recUpdFieldToProjUpdate (fmap mk_rec_upd_field f)
-                 } )
+    toProjUpdates :: [Fbind (HsExpr GhcPs)] -> [LHsRecUpdField GhcPs]
+    toProjUpdates = map f
+
+    f :: Fbind (HsExpr GhcPs) -> LHsRecUpdField GhcPs
+    f upd = case upd of
+        Left (L l recField@(HsRecField (L loc (FieldOcc _ rdr)) arg pun)) ->
+          if pun
+            then L l (mk_rec_upd_field recField{
+                     hsRecFieldArg = mkVar (occNameString . rdrNameOcc $ (unLoc rdr))}
+                 )
+            else L l (mk_rec_upd_field recField)
+        Right (L l (HsRecField (L loc (FieldLabelStrings fs)) arg pun)) ->
+          let fs' = map (Ambiguous noExtField . fmap mkVarUnqual) fs
+          in L l ( HsRecField {
+                    hsRecFieldLbl = L loc (NE.fromList fs')
+                  , hsRecFieldArg = arg
+                  , hsRecPun = pun } )
+    mkVar = noLoc . HsVar noExtField . noLoc . mkRdrUnqual . mkVarOcc
 
 mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs
 mkRdrRecordCon con flds
@@ -2220,7 +2235,10 @@ mk_rec_fields fs (Just s)  = HsRecFields { rec_flds = fs
 
 mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs
 mk_rec_upd_field (HsRecField (L loc (FieldOcc _ rdr)) arg pun)
-  = HsRecField (L loc (Unambiguous noExtField rdr)) arg pun
+  =
+  let fieldOcc = Unambiguous noExtField rdr
+      fieldOccs = fieldOcc :| [] -- Singleton
+  in HsRecField (L loc fieldOccs) arg pun
 
 mkInlinePragma :: SourceText -> (InlineSpec, RuleMatchInfo) -> Maybe Activation
                -> InlinePragma
@@ -2718,23 +2736,7 @@ mkRdrProjUpdate _ (L _ []) _ _ = panic "mkRdrProjUpdate: The impossible has happ
 mkRdrProjUpdate loc (L l flds) arg isPun =
   L loc HsRecField {
       hsRecFieldLbl = L l (FieldLabelStrings flds)
-    , hsRecFieldArg = arg
+    , hsRecFieldArg = arg -- Parser handleds pun
     , hsRecPun = isPun
   }
-
-recUpdFieldToProjUpdate :: LHsRecUpdField GhcPs -> LHsRecUpdProj GhcPs
-recUpdFieldToProjUpdate (L l (HsRecField occ arg pun)) =
-  mkRdrProjUpdate l (L loc [L loc (fsLit f)]) (val arg) pun
-  where
-    (loc, f) = field occ
-
-    val :: LHsExpr GhcPs -> LHsExpr GhcPs
-    val arg = if pun then mkVar $ snd (field occ) else arg
-
-    field :: Located (AmbiguousFieldOcc GhcPs) -> (SrcSpan, String)
-    field = \case
-        L _ (Ambiguous _ (L loc lbl)) ->  (loc, occNameString . rdrNameOcc $ lbl)
-        L _ (Unambiguous _ (L loc lbl)) -> (loc, occNameString . rdrNameOcc $ lbl)
-
-    mkVar :: String -> LHsExpr GhcPs
-    mkVar = noLoc . HsVar noExtField . noLoc . mkRdrUnqual . mkVarOcc
+  -- where  mkVar = noLoc . HsVar noExtField . noLoc . mkRdrUnqual . mkVarOcc
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 71a6e611d5..04c868da43 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -424,25 +424,28 @@ rnExpr (RecordCon { rcon_con = con_id
     rn_field (L l fld) = do { (arg', fvs) <- rnLExpr (hsRecFieldArg fld)
                             ; return (L l (fld { hsRecFieldArg = arg' }), fvs) }
 
-rnExpr (RecordUpd { rupd_expr = expr, rupd_flds = rbinds })
-  = 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."
-             ; (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 (RecordUpd { rupd_expr = expr, rupd_flds = flds })
+  = do
+       { ; overloaded_on <- xoptM LangExt.OverloadedRecordUpdate
+         ; if not overloaded_on
+           then -- 'OverloadedRecordUpdate' is not in effect. Regular record update.
+             do  { ; (e, fv_e) <- rnLExpr expr
+                   ; (rs, fv_rs) <- rnHsRecUpdFields flds
+                   ; return ( RecordUpd noExtField e rs, fv_e `plusFV` fv_rs )
+                 }
+           else  -- 'OverloadedRecordUpdate' is in effect. Record dot update desugaring.
+             do { ; unlessXOptM LangExt.RebindableSyntax $
+                      addErr $ text "RebindableSyntax is required if OverloadedRecordUpdate is enabled."
+                  ; (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 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
@@ -2602,18 +2605,29 @@ mkProjUpdateSetField get_field set_field (L _ (HsRecField { hsRecFieldLbl = (L _
     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 :: Name -> Name -> LHsExpr GhcRn -> [LHsRecUpdField 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)
+    fieldUpdate :: HsExpr GhcRn -> LHsRecUpdField GhcRn -> HsExpr GhcRn
+    fieldUpdate acc (L l (HsRecField (L ll lbl) arg pun)) =
+      let afos = lbl
+          afos' = NE.toList afos
+          fieldNames = map (wrapGenSpan . occNameFS . rdrNameOcc . rdrNameAmbiguousFieldOcc) afos'
+          fields = L ll (FieldLabelStrings fieldNames)
+          lpu = L l (HsRecField fields arg pun)
+      in unLoc $ (mkProjUpdateSetField get_field set_field lpu) (wrapGenSpan acc)
+
+rnHsUpdProjs :: [LHsRecUpdField GhcPs] -> RnM ([LHsRecUpdField GhcRn], FreeVars)
 rnHsUpdProjs us = do
   (u, fvs) <- unzip <$> mapM rnRecUpdProj us
   pure (u, plusFVs fvs)
   where
-    rnRecUpdProj :: LHsRecUpdProj GhcPs -> RnM (LHsRecUpdProj GhcRn, FreeVars)
+    rnRecUpdProj :: LHsRecUpdField GhcPs -> RnM (LHsRecUpdField 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) }
+           ; return $ (L l (HsRecField { hsRecFieldLbl = fmap (NE.map f) fs, hsRecFieldArg = arg, hsRecPun = pun}), fv) }
+
+    f :: AmbiguousFieldOcc GhcPs -> AmbiguousFieldOcc GhcRn
+    f (Ambiguous _ rdr) = Ambiguous noExtField rdr
+    f (Unambiguous _ rdr) = Ambiguous noExtField rdr
+    f _ = panic "rnHsUpdProjs: The impossible happened!"
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index a1bd52be3f..a8cdbb49ef 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -79,6 +79,7 @@ import GHC.Driver.Session ( getDynFlags, xopt_DuplicateRecordFields )
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad       ( when, ap, guard, forM, unless )
+import Data.List.NonEmpty(NonEmpty(..))
 import qualified Data.List.NonEmpty as NE
 import Data.Maybe
 import Data.Ratio
@@ -765,7 +766,7 @@ rnHsRecUpdFields flds
     rn_fld pun_ok dup_fields_ok (L l (HsRecField { hsRecFieldLbl = L loc f
                                                , hsRecFieldArg = arg
                                                , hsRecPun      = pun }))
-      = do { let lbl = rdrNameAmbiguousFieldOcc f
+      = do { let lbl = rdrNameAmbiguousFieldOcc (NE.head f)
            ; mb_sel <- setSrcSpan loc $
                       -- Defer renaming of overloaded fields to the typechecker
                       -- See Note [Disambiguating record fields] in GHC.Tc.Gen.Head
@@ -783,7 +784,7 @@ rnHsRecUpdFields flds
                                            in (Unambiguous sel_name (L loc lbl), fvs `addOneFV` sel_name)
                    AmbiguousFields       -> (Ambiguous   noExtField (L loc lbl), fvs)
 
-           ; return (L l (HsRecField { hsRecFieldLbl = L loc lbl'
+           ; return (L l (HsRecField { hsRecFieldLbl = L loc (lbl' :| [])
                                      , hsRecFieldArg = arg''
                                      , hsRecPun      = pun }), fvs') }
 
@@ -803,7 +804,7 @@ getFieldLbls flds
   = map (unLoc . rdrNameFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds
 
 getFieldUpdLbls :: [LHsRecUpdField GhcPs] -> [RdrName]
-getFieldUpdLbls flds = map (rdrNameAmbiguousFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds
+getFieldUpdLbls flds = map (rdrNameAmbiguousFieldOcc . (NE.head) . unLoc . hsRecFieldLbl . unLoc) flds
 
 needFlagDotDot :: HsRecFieldContext -> SDoc
 needFlagDotDot ctxt = vcat [text "Illegal `..' in record" <+> pprRFC ctxt,
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index b67df59ca1..3d98923c84 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -84,6 +84,8 @@ import GHC.Types.Unique.Set ( UniqSet, mkUniqSet, elementOfUniqSet, nonDetEltsUn
 
 import Data.Function
 import Data.List (partition, sortBy, groupBy, intersect)
+import Data.List.NonEmpty(NonEmpty(..))
+import qualified Data.List.NonEmpty as NE
 
 {-
 ************************************************************************
@@ -641,11 +643,7 @@ following.
 
 -}
 
--- 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
+tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = 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
@@ -665,8 +663,8 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = Left rbnds }) res_
 
         -- STEP -1  See Note [Disambiguating record fields] in GHC.Tc.Gen.Head
         -- After this we know that rbinds is unambiguous
-        ; rbinds <- disambiguateRecordBinds record_expr record_rho rbnds res_ty
-        ; let upd_flds = map (unLoc . hsRecFieldLbl . unLoc) rbinds
+        ; rbinds :: [LHsRecField' (NonEmpty (AmbiguousFieldOcc GhcTc)) (LHsExpr GhcRn)] <- disambiguateRecordBinds record_expr record_rho rbnds res_ty
+        ; let upd_flds = map (NE.head . unLoc . hsRecFieldLbl . unLoc) rbinds
               upd_fld_occs = map (occNameFS . rdrNameOcc . rdrNameAmbiguousFieldOcc) upd_flds
               sel_ids      = map selectorAmbiguousFieldOcc upd_flds
         -- STEP 0
@@ -676,7 +674,7 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = Left rbnds }) res_
         ; let bad_guys = [ setSrcSpan loc $ addErrTc (notSelector fld_name)
                          | fld <- rbinds,
                            -- Excludes class ops
-                           let L loc sel_id = hsRecUpdFieldId (unLoc fld),
+                           let L loc sel_id = hsRecUpdFieldId' (unLoc fld),
                            not (isRecordSelector sel_id),
                            let fld_name = idName sel_id ]
         ; unless (null bad_guys) (sequence bad_guys >> failM)
@@ -812,12 +810,10 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = Left rbnds }) res_
                                    , rupd_wrap = req_wrap }
               expr' = RecordUpd { rupd_expr = mkLHsWrap fam_co $
                                                 mkLHsWrapCo co_scrut record_expr'
-                                , rupd_flds = Left rbinds'
+                                , rupd_flds = rbinds'
                                 , rupd_ext = upd_tc }
 
         ; tcWrapResult expr expr' rec_res_ty res_ty }
-tcExpr (RecordUpd {}) _ = panic "GHC.Tc.Gen.Expr: tcExpr: The impossible happened!"
-
 
 {-
 ************************************************************************
@@ -1190,7 +1186,7 @@ getFixedTyVars upd_fld_occs univ_tvs cons
 -- See Note [Disambiguating record fields] in GHC.Tc.Gen.Head
 disambiguateRecordBinds :: LHsExpr GhcRn -> TcRhoType
                  -> [LHsRecUpdField GhcRn] -> ExpRhoType
-                 -> TcM [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
+                 -> TcM [LHsRecField' (NonEmpty (AmbiguousFieldOcc GhcTc)) (LHsExpr GhcRn)]
 disambiguateRecordBinds record_expr record_rho rbnds res_ty
     -- Are all the fields unambiguous?
   = case mapM isUnambiguous rbnds of
@@ -1209,7 +1205,7 @@ disambiguateRecordBinds record_expr record_rho rbnds res_ty
   where
     -- Extract the selector name of a field update if it is unambiguous
     isUnambiguous :: LHsRecUpdField GhcRn -> Maybe (LHsRecUpdField GhcRn,Name)
-    isUnambiguous x = case unLoc (hsRecFieldLbl (unLoc x)) of
+    isUnambiguous x = case NE.head (unLoc (hsRecFieldLbl (unLoc x))) of
                         Unambiguous sel_name _ -> Just (x, sel_name)
                         Ambiguous{}            -> Nothing
 
@@ -1252,7 +1248,7 @@ disambiguateRecordBinds record_expr record_rho rbnds res_ty
     -- where T does not have field x.
     pickParent :: RecSelParent
                -> (LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])
-               -> TcM (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
+               -> TcM (LHsRecField' (NonEmpty (AmbiguousFieldOcc GhcTc)) (LHsExpr GhcRn))
     pickParent p (upd, xs)
       = case lookup p xs of
                       -- Phew! The parent is valid for this field.
@@ -1273,13 +1269,13 @@ disambiguateRecordBinds record_expr record_rho rbnds res_ty
     -- Given a (field update, selector name) pair, look up the
     -- selector to give a field update with an unambiguous Id
     lookupSelector :: (LHsRecUpdField GhcRn, Name)
-                 -> TcM (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
+                 -> TcM (LHsRecField' (NonEmpty (AmbiguousFieldOcc GhcTc)) (LHsExpr GhcRn))
     lookupSelector (L l upd, n)
       = do { i <- tcLookupId n
            ; let L loc af = hsRecFieldLbl upd
-                 lbl      = rdrNameAmbiguousFieldOcc af
+                 lbl      = rdrNameAmbiguousFieldOcc (NE.head af)
            ; return $ L l upd { hsRecFieldLbl
-                                  = L loc (Unambiguous i (L loc lbl)) } }
+                                  = L loc ((Unambiguous i (L loc lbl)):|[]) } }
 
 
 {-
@@ -1327,20 +1323,21 @@ tcRecordBinds con_like arg_tys (HsRecFields rbinds dd)
 tcRecordUpd
         :: ConLike
         -> [TcType]     -- Expected type for each field
-        -> [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
+        -> [LHsRecField' (NonEmpty (AmbiguousFieldOcc GhcTc)) (LHsExpr GhcRn)]
         -> TcM [LHsRecUpdField GhcTc]
 
-tcRecordUpd con_like arg_tys rbinds = fmap catMaybes $ mapM do_bind rbinds
+tcRecordUpd con_like arg_tys rbinds =
+ fmap catMaybes $ mapM do_bind rbinds
   where
     fields = map flSelector $ conLikeFieldLabels con_like
-    flds_w_tys = zipEqual "tcRecordUpd" fields arg_tys
+    flds_w_tys = zipEqual "tcRecordUpd'" fields arg_tys
 
-    do_bind :: LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
+    do_bind :: LHsRecField' (NonEmpty (AmbiguousFieldOcc GhcTc)) (LHsExpr GhcRn)
             -> TcM (Maybe (LHsRecUpdField GhcTc))
     do_bind (L l fld@(HsRecField { hsRecFieldLbl = L loc af
                                  , hsRecFieldArg = rhs }))
-      = do { let lbl = rdrNameAmbiguousFieldOcc af
-                 sel_id = selectorAmbiguousFieldOcc af
+      = do { let lbl = rdrNameAmbiguousFieldOcc (NE.head af)
+                 sel_id = selectorAmbiguousFieldOcc (NE.head af)
                  f = L loc (FieldOcc (idName sel_id) (L loc lbl))
            ; mb <- tcRecordField con_like flds_w_tys f rhs
            ; case mb of
@@ -1348,9 +1345,9 @@ tcRecordUpd con_like arg_tys rbinds = fmap catMaybes $ mapM do_bind rbinds
                Just (f', rhs') ->
                  return (Just
                          (L l (fld { hsRecFieldLbl
-                                      = L loc (Unambiguous
+                                      = L loc ((Unambiguous
                                                (extFieldOcc (unLoc f'))
-                                               (L loc lbl))
+                                               (L loc lbl)):| [])
                                    , hsRecFieldArg = rhs' }))) }
 
 tcRecordField :: ConLike -> Assoc Name Type
@@ -1450,7 +1447,7 @@ badFieldTypes prs
        2 (vcat [ ppr f <+> dcolon <+> ppr ty | (f,ty) <- prs ])
 
 badFieldsUpd
-  :: [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
+  :: [LHsRecField' (NonEmpty (AmbiguousFieldOcc GhcTc)) (LHsExpr GhcRn)]
                -- Field names that don't belong to a single datacon
   -> [ConLike] -- Data cons of the type which the first field name belongs to
   -> SDoc
@@ -1486,7 +1483,7 @@ badFieldsUpd rbinds data_cons
     membership :: [(FieldLabelString, [Bool])]
     membership = sortMembership $
         map (\fld -> (fld, map (fld `elementOfUniqSet`) fieldLabelSets)) $
-          map (occNameFS . rdrNameOcc . rdrNameAmbiguousFieldOcc . unLoc . hsRecFieldLbl . unLoc) rbinds
+          map (occNameFS . rdrNameOcc . rdrNameAmbiguousFieldOcc . NE.head . unLoc . hsRecFieldLbl . unLoc) rbinds
 
     fieldLabelSets :: [UniqSet FieldLabelString]
     fieldLabelSets = map (mkUniqSet . map flLabel . conLikeFieldLabels) data_cons
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 9c22841a51..e11c5a65fe 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -97,6 +97,7 @@ import GHC.Data.Bag
 
 import Control.Monad
 import Data.List  ( partition )
+import Data.List.NonEmpty( NonEmpty(..) )
 import Control.Arrow ( second )
 
 {-
@@ -453,6 +454,13 @@ zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
 zonkFieldOcc env (FieldOcc sel lbl)
   = fmap ((flip FieldOcc) lbl) $ zonkIdBndr env sel
 
+zonkFieldOcc' :: ZonkEnv -> NonEmpty (FieldOcc GhcTc) -> TcM (NonEmpty (FieldOcc GhcTc))
+zonkFieldOcc' env (FieldOcc sel lbl :| []) =
+ do
+   r <- zonkIdBndr env sel
+   return ((FieldOcc r lbl) :| [])
+zonkFieldOcc' _ _ = panic "zonkFieldOcc': The impossible happened!"
+
 zonkEvBndrsX :: ZonkEnv -> [EvVar] -> TcM (ZonkEnv, [Var])
 zonkEvBndrsX = mapAccumLM zonkEvBndrX
 
@@ -940,10 +948,7 @@ zonkExpr env expr@(RecordCon { rcon_ext = con_expr, rcon_flds = rbinds })
         ; return (expr { rcon_ext  = new_con_expr
                        , rcon_flds = new_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
+zonkExpr env (RecordUpd { rupd_flds = rbinds
                         , rupd_expr = expr
                         , rupd_ext = RecordUpdTc {
                                        rupd_cons = cons
@@ -958,13 +963,12 @@ zonkExpr env (RecordUpd { rupd_flds = Left rbinds
         ; return (
             RecordUpd {
                   rupd_expr = new_expr
-                , rupd_flds = Left new_rbinds
+                , 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 }}) }
-zonkExpr _ (RecordUpd {}) = panic "GHC.Tc.Utils.Zonk: zonkExpr: The impossible happened!"
 
 zonkExpr env (ExprWithTySig _ e ty)
   = do { e' <- zonkLExpr env e
@@ -1363,15 +1367,20 @@ zonkRecFields env (HsRecFields flds dd)
            ; return (L l (fld { hsRecFieldLbl = new_id
                               , hsRecFieldArg = new_expr })) }
 
-zonkRecUpdFields :: ZonkEnv -> [LHsRecUpdField GhcTc]
-                 -> TcM [LHsRecUpdField GhcTc]
+zonkRecUpdFields :: ZonkEnv -> [LHsRecUpdField GhcTc] -> TcM [LHsRecUpdField GhcTc]
 zonkRecUpdFields env = mapM zonk_rbind
   where
     zonk_rbind (L l fld)
-      = do { new_id   <- wrapLocM (zonkFieldOcc env) (hsRecUpdFieldOcc fld)
+      = do { new_id   <- wrapLocM (zonkFieldOcc' env) (hsRecUpdFieldOcc' fld)
            ; new_expr <- zonkLExpr env (hsRecFieldArg fld)
-           ; return (L l (fld { hsRecFieldLbl = fmap ambiguousFieldOcc new_id
-                              , hsRecFieldArg = new_expr })) }
+           ; return (L l (fld { hsRecFieldLbl = ambig new_id
+                              , hsRecFieldArg = new_expr }))
+           }
+
+    ambig id =
+      case id of
+        L l (fieldOcc :| []) -> L l ((ambiguousFieldOcc fieldOcc) :| [])
+        _ ->  panic "zonkRecUpdFields: The impossible happened!"
 
 -------------------------------------------------------------------------
 mapIPNameTc :: (a -> TcM b) -> Either (Located HsIPName) a
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index bc003b749c..497ce76933 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -59,6 +59,7 @@ import qualified Data.ByteString as BS
 import Control.Monad( unless, ap )
 
 import Data.Maybe( catMaybes, isNothing )
+import Data.List.NonEmpty(NonEmpty(..))
 import Language.Haskell.TH as TH hiding (sigP)
 import Language.Haskell.TH.Syntax as TH
 import Foreign.ForeignPtr
@@ -1018,9 +1019,9 @@ cvtl e = wrapL (cvt e)
                               ; return $ mkRdrRecordCon c' (HsRecFields flds' Nothing) }
     cvt (RecUpdE e flds) = do { e' <- cvtl e
                               ; flds'
-                                  <- mapM (cvtFld (mkAmbiguousFieldOcc . noLoc))
+                                  <- mapM (cvtFld (\r -> mkAmbiguousFieldOcc (noLoc r) :| []))
                                            flds
-                              ; return $ RecordUpd noExtField e' (Left flds') }
+                              ; return $ RecordUpd noExtField e' 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 06410a9796..92bf1a7291 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -470,7 +470,7 @@ data HsExpr p
   | RecordUpd
       { rupd_ext  :: XRecordUpd p
       , rupd_expr :: LHsExpr p
-      , rupd_flds :: Either [LHsRecUpdField p] [LHsRecUpdProj p]
+      , rupd_flds :: [LHsRecUpdField p]
       }
   -- For a type family, the arg types are of the *instance* tycon,
   -- not the family tycon
diff --git a/compiler/Language/Haskell/Syntax/Pat.hs b/compiler/Language/Haskell/Syntax/Pat.hs
index 8de0cc96d3..124e14638e 100644
--- a/compiler/Language/Haskell/Syntax/Pat.hs
+++ b/compiler/Language/Haskell/Syntax/Pat.hs
@@ -46,6 +46,7 @@ import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
 -- libraries:
 import Data.Data hiding (TyCon,Fixity)
+import Data.List.NonEmpty(NonEmpty(..))
 
 type LPat p = XRec p (Pat p)
 
@@ -271,7 +272,7 @@ type LHsRecUpdField p   = Located (HsRecUpdField p)
 type HsRecField    p arg = HsRecField' (FieldOcc p) arg
 
 -- | Haskell Record Update Field
-type HsRecUpdField p     = HsRecField' (AmbiguousFieldOcc p) (LHsExpr p)
+type HsRecUpdField p     = HsRecField' (NonEmpty (AmbiguousFieldOcc p)) (LHsExpr p)
 
 -- | Haskell Record Field
 --