Refactor HsExpr.RecordCon, RecordUpd

This follows Matthew's patch making pattern synoyms work
with records.

This patch
 - replaces the (PostTc id [FieldLabel]) field of
   RecordCon with (PostTc id ConLike)

 - record-ises both RecordCon and RecordUpd, which
   both have quite a lot of fields.

No change in behaviour

3 files changed, 32 insertions, 32 deletions

diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index e1b45a721f..95c70aa212 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -536,18 +536,14 @@ addTickHsExpr (ExplicitPArr ty es) =
 
 addTickHsExpr (HsStatic e) = HsStatic <$> addTickLHsExpr e
 
-addTickHsExpr (RecordCon id ty rec_binds labels) =
-        liftM4 RecordCon
-                (return id)
-                (return ty)
-                (addTickHsRecordBinds rec_binds)
-                (return labels)
-addTickHsExpr (RecordUpd e rec_binds cons tys1 tys2 req_wrap) =
-        return RecordUpd `ap`
-                (addTickLHsExpr e) `ap`
-                (mapM addTickHsRecField rec_binds) `ap`
-                (return cons) `ap` (return tys1) `ap` (return tys2) `ap`
-                (return req_wrap)
+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 })
+  = do { e' <- addTickLHsExpr e
+       ; flds' <- mapM addTickHsRecField flds
+       ; return (expr { rupd_expr = e', rupd_flds = flds' }) }
 
 addTickHsExpr (ExprWithTySigOut e ty) =
         liftM2 ExprWithTySigOut
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index dbe3bc69de..44e0aa0977 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -497,26 +497,28 @@ We also handle @C{}@ as valid construction syntax for an unlabelled
 constructor @C@, setting all of @C@'s fields to bottom.
 -}
 
-dsExpr (RecordCon _ con_expr rbinds labels) = do
-    con_expr' <- dsExpr con_expr
-    let
-        (arg_tys, _) = tcSplitFunTys (exprType con_expr')
-        -- A newtype in the corner should be opaque;
-        -- hence TcType.tcSplitFunTys
+dsExpr (RecordCon { rcon_con_expr = con_expr, rcon_flds = rbinds
+                  , rcon_con_like = con_like })
+  = do { con_expr' <- dsExpr con_expr
+       ; let
+             (arg_tys, _) = tcSplitFunTys (exprType con_expr')
+             -- A newtype in the corner should be opaque;
+             -- hence TcType.tcSplitFunTys
 
-        mk_arg (arg_ty, fl)
-          = case findField (rec_flds rbinds) (flSelector fl) of
-              (rhs:rhss) -> ASSERT( null rhss )
-                            dsLExpr rhs
-              []         -> mkErrorAppDs rEC_CON_ERROR_ID arg_ty (ppr (flLabel fl))
-        unlabelled_bottom arg_ty = mkErrorAppDs rEC_CON_ERROR_ID arg_ty Outputable.empty
+             mk_arg (arg_ty, fl)
+               = case findField (rec_flds rbinds) (flSelector fl) of
+                   (rhs:rhss) -> ASSERT( null rhss )
+                                 dsLExpr rhs
+                   []         -> mkErrorAppDs rEC_CON_ERROR_ID arg_ty (ppr (flLabel fl))
+             unlabelled_bottom arg_ty = mkErrorAppDs rEC_CON_ERROR_ID arg_ty Outputable.empty
 
+             labels = conLikeFieldLabels con_like
 
-    con_args <- if null labels
-                then mapM unlabelled_bottom arg_tys
-                else mapM mk_arg (zipEqual "dsExpr:RecordCon" arg_tys labels)
+       ; con_args <- if null labels
+                     then mapM unlabelled_bottom arg_tys
+                     else mapM mk_arg (zipEqual "dsExpr:RecordCon" arg_tys labels)
 
-    return (mkCoreApps con_expr' con_args)
+       ; return (mkCoreApps con_expr' con_args) }
 
 {-
 Record update is a little harder. Suppose we have the decl:
@@ -553,8 +555,10 @@ But if x::T a b, then
 So we need to cast (T a Int) to (T a b).  Sigh.
 -}
 
-dsExpr expr@(RecordUpd record_expr fields
-                        cons_to_upd in_inst_tys out_inst_tys dict_req_wrap )
+dsExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields
+                       , rupd_cons = cons_to_upd
+                       , rupd_in_tys = in_inst_tys, rupd_out_tys = out_inst_tys
+                       , rupd_wrap = dict_req_wrap } )
   | null fields
   = dsLExpr record_expr
   | otherwise
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index b61d670cc5..0b9906f7f1 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -1143,11 +1143,11 @@ repE e@(ExplicitTuple es boxed)
   | otherwise      = do { xs <- repLEs [e | L _ (Present e) <- es]
                         ; repUnboxedTup xs }
 
-repE (RecordCon c _ flds _)
+repE (RecordCon { rcon_con_name = c, rcon_flds = flds })
  = do { x <- lookupLOcc c;
         fs <- repFields flds;
         repRecCon x fs }
-repE (RecordUpd e flds _ _ _ _)
+repE (RecordUpd { rupd_expr = e, rupd_flds = flds })
  = do { x <- repLE e;
         fs <- repUpdFields flds;
         repRecUpd x fs }