Desugar RecordUpd in `tcExpr`wip/T18802

This patch typechecks record updates by desugaring them inside
the typechecker using the HsExpansion mechanism, and then typechecking
this desugared result.

Example:

    data T p q = T1 { x :: Int, y :: Bool, z :: Char }
               | T2 { v :: Char }
               | T3 { x :: Int }
               | T4 { p :: Float, y :: Bool, x :: Int }
               | T5

The record update `e { x=e1, y=e2 }` desugars as follows

  e { x=e1, y=e2 }
    ===>
  let { x' = e1; y' = e2 } in
  case e of
     T1 _ _ z -> T1 x' y' z
     T4 p _ _ -> T4 p y' x'

The desugared expression is put into an HsExpansion, and we typecheck
that.

The full details are given in Note [Record Updates] in GHC.Tc.Gen.Expr.

Fixes #2595 #3632 #10808 #10856 #16501 #18311 #18802 #21158 #21289

Updates haddock submodule

4 files changed, 10 insertions, 24 deletions

diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index a4960ca555..76699dc4f3 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -163,21 +163,6 @@ instance Outputable SyntaxExprTc where
 
   ppr NoSyntaxExprTc = text "<no syntax expr>"
 
--- | Extra data fields for a 'RecordUpd', added by the type checker
-data RecordUpdTc = RecordUpdTc
-      { rupd_cons :: [ConLike]
-                -- Filled in by the type checker to the
-                -- _non-empty_ list of DataCons that have
-                -- all the upd'd fields
-
-      , rupd_in_tys  :: [Type]  -- Argument types of *input* record type
-      , rupd_out_tys :: [Type]  --             and  *output* record type
-                -- For a data family, these are the type args of the
-                -- /representation/ type constructor
-
-      , rupd_wrap :: HsWrapper  -- See Note [Record Update HsWrapper]
-      }
-
 -- | HsWrap appears only in typechecker output
 data HsWrap hs_syn = HsWrap HsWrapper      -- the wrapper
                             (hs_syn GhcTc) -- the thing that is wrapped
@@ -397,7 +382,10 @@ type instance XRecordCon     GhcTc = PostTcExpr   -- Instantiated constructor fu
 
 type instance XRecordUpd     GhcPs = EpAnn [AddEpAnn]
 type instance XRecordUpd     GhcRn = NoExtField
-type instance XRecordUpd     GhcTc = RecordUpdTc
+type instance XRecordUpd     GhcTc = DataConCantHappen
+  -- We desugar record updates in the typechecker.
+  -- See [Handling overloaded and rebindable constructs],
+  -- and [Record Updates] in GHC.Tc.Gen.Expr.
 
 type instance XGetField     GhcPs = EpAnnCO
 type instance XGetField     GhcRn = NoExtField
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index 987e47f047..1904de63d4 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -395,7 +395,6 @@ deriving instance Data (ArithSeqInfo GhcPs)
 deriving instance Data (ArithSeqInfo GhcRn)
 deriving instance Data (ArithSeqInfo GhcTc)
 
-deriving instance Data RecordUpdTc
 deriving instance Data CmdTopTc
 deriving instance Data PendingRnSplice
 deriving instance Data PendingTcSplice
diff --git a/compiler/GHC/Hs/Syn/Type.hs b/compiler/GHC/Hs/Syn/Type.hs
index be1fd40ce0..b93d87a9b3 100644
--- a/compiler/GHC/Hs/Syn/Type.hs
+++ b/compiler/GHC/Hs/Syn/Type.hs
@@ -116,11 +116,7 @@ hsExprType (HsLet _ _ _ _ body) = lhsExprType body
 hsExprType (HsDo ty _ _) = ty
 hsExprType (ExplicitList ty _) = mkListTy ty
 hsExprType (RecordCon con_expr _ _) = hsExprType con_expr
-hsExprType e@(RecordUpd (RecordUpdTc { rupd_cons = cons, rupd_out_tys = out_tys }) _ _) =
-  case cons of
-    con_like:_ -> conLikeResTy con_like out_tys
-    []         -> pprPanic "hsExprType: RecordUpdTc with empty rupd_cons"
-                           (ppr e)
+hsExprType (RecordUpd v _ _) = dataConCantHappen v
 hsExprType (HsGetField { gf_ext = v }) = dataConCantHappen v
 hsExprType (HsProjection { proj_ext = v }) = dataConCantHappen v
 hsExprType (ExprWithTySig _ e _) = lhsExprType e
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 8e2980edaa..e5bcd5959f 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -345,13 +345,17 @@ emptyRecStmtName :: (Anno [GenLocated
                         ~ SrcSpanAnnL)
                  => StmtLR GhcRn GhcRn bodyR
 emptyRecStmtId   :: Stmt GhcTc (LocatedA (HsCmd GhcTc))
-mkRecStmt        :: (Anno [GenLocated
+
+mkRecStmt :: forall (idL :: Pass) bodyR.
+                    (Anno [GenLocated
                              (Anno (StmtLR (GhcPass idL) GhcPs bodyR))
                              (StmtLR (GhcPass idL) GhcPs bodyR)]
                         ~ SrcSpanAnnL)
                  => EpAnn AnnList
                  -> LocatedL [LStmtLR (GhcPass idL) GhcPs bodyR]
                  -> StmtLR (GhcPass idL) GhcPs bodyR
+mkRecStmt anns stmts  = (emptyRecStmt' anns :: StmtLR (GhcPass idL) GhcPs bodyR)
+                             { recS_stmts = stmts }
 
 
 mkHsIntegral     i  = OverLit noExtField (HsIntegral       i)
@@ -438,7 +442,6 @@ emptyRecStmt     = emptyRecStmt' noAnn
 emptyRecStmtName = emptyRecStmt' noExtField
 emptyRecStmtId   = emptyRecStmt' unitRecStmtTc
                                         -- a panic might trigger during zonking
-mkRecStmt anns stmts  = (emptyRecStmt' anns) { recS_stmts = stmts }
 
 mkLetStmt :: EpAnn [AddEpAnn] -> HsLocalBinds GhcPs -> StmtLR GhcPs GhcPs (LocatedA b)
 mkLetStmt anns binds = LetStmt anns binds