From: simonmar <unknown>
Date: Wed, 16 May 2001 11:36:05 +0000 (+0000)
Subject: [project @ 2001-05-16 11:36:05 by simonmar]
X-Git-Tag: Approximately_9120_patches~1946
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=2f41561d35ed975332d1cd56e7b49ff6731dcfab;hp=038af69f4ee2778abde793e38d763f0e5280fc4a;p=ghc-hetmet.git

[project @ 2001-05-16 11:36:05 by simonmar]
Fix for a bug which affects record updates when the record has strict
unboxed fields (i.e. -funbox-strict-fields is on).

MERGE with 5.00 (after testing, and if it can be done before the release)
---

diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
index abb2f1e..a7f8267 100644
--- a/ghc/compiler/deSugar/DsExpr.lhs
+++ b/ghc/compiler/deSugar/DsExpr.lhs
@@ -34,7 +34,7 @@ import FieldLabel	( FieldLabel, fieldLabelTyCon )
 import CostCentre	( mkUserCC )
 import Id		( Id, idType, recordSelectorFieldLabel )
 import PrelInfo		( rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID )
-import DataCon		( DataCon, dataConWrapId, dataConArgTys, dataConFieldLabels )
+import DataCon		( DataCon, dataConWrapId, dataConFieldLabels, dataConInstOrigArgTys )
 import DataCon		( isExistentialDataCon )
 import Literal		( Literal(..) )
 import TyCon		( tyConDataCons )
@@ -408,7 +408,7 @@ dsExpr (RecordUpdOut record_expr record_out_ty dicts rbinds)
 	      []	 -> HsVar old_arg_id
 
 	mk_alt con
-	  = newSysLocalsDs (dataConArgTys con in_inst_tys)	`thenDs` \ arg_ids ->
+	  = newSysLocalsDs (dataConInstOrigArgTys con in_inst_tys) `thenDs` \ arg_ids ->
 		-- This call to dataConArgTys won't work for existentials
 	    let 
 		val_args = zipWithEqual "dsExpr:RecordUpd" mk_val_arg