+tcExpr (RecordCon (HsVar con) rbinds)
+ = tcId con `thenNF_Tc` \ (con_expr, con_lie, con_tau) ->
+ let
+ (_, record_ty) = splitFunTy con_tau
+ in
+ -- Con is syntactically constrained to be a data constructor
+ ASSERT( maybeToBool (maybeAppDataTyCon record_ty ) )
+
+ tcRecordBinds record_ty rbinds `thenTc` \ (rbinds', rbinds_lie) ->
+
+ -- Check that the record bindings match the constructor
+ tcLookupGlobalValue con `thenNF_Tc` \ con_id ->
+ checkTc (checkRecordFields rbinds con_id)
+ (badFieldsCon con rbinds) `thenTc_`
+
+ returnTc (RecordCon con_expr rbinds', con_lie `plusLIE` rbinds_lie, record_ty)
+
+-- One small complication in RecordUpd is that we have to generate some
+-- dictionaries for the data type context, since we are going to
+-- do some construction.
+--
+-- What dictionaries do we need? For the moment we assume that all
+-- data constructors have the same context, and grab it from the first
+-- constructor. If they have varying contexts then we'd have to
+-- union the ones that could participate in the update.
+
+tcExpr (RecordUpd record_expr rbinds)
+ = ASSERT( not (null rbinds) )
+ tcAddErrCtxt recordUpdCtxt $
+
+ tcExpr record_expr `thenTc` \ (record_expr', record_lie, record_ty) ->
+ tcRecordBinds record_ty rbinds `thenTc` \ (rbinds', rbinds_lie) ->
+
+ -- Check that the field names are plausible
+ zonkTcType record_ty `thenNF_Tc` \ record_ty' ->
+ let
+ (tycon, inst_tys, data_cons) = _trace "getAppDataTyCon.TcExpr" $ getAppDataTyCon record_ty'
+ -- The record binds are non-empty (syntax); so at least one field
+ -- label will have been unified with record_ty by tcRecordBinds;
+ -- field labels must be of data type; hencd the getAppDataTyCon must succeed.
+ (tyvars, theta, _, _) = dataConSig (head data_cons)
+ in
+ tcInstTheta (tyvars `zipEqual` inst_tys) theta `thenNF_Tc` \ theta' ->
+ newDicts RecordUpdOrigin theta' `thenNF_Tc` \ (con_lie, dicts) ->
+ checkTc (any (checkRecordFields rbinds) data_cons)
+ (badFieldsUpd rbinds) `thenTc_`
+
+ returnTc (RecordUpdOut record_expr' dicts rbinds',
+ con_lie `plusLIE` record_lie `plusLIE` rbinds_lie,
+ record_ty)