[project @ 2002-02-14 14:56:04 by simonpj]

[ghc-hetmet.git] / ghc / compiler / deSugar / DsExpr.lhs

diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
index 5d7ff19..45b02fb 100644 (file)
--- a/ghc/compiler/deSugar/DsExpr.lhs
+++ b/ghc/compiler/deSugar/DsExpr.lhs
@@ -22,7 +22,7 @@ import TcHsSyn                ( TypecheckedHsExpr, TypecheckedHsBinds, TypecheckedStmt, outPat
 --     So WATCH OUT; check each use of split*Ty functions.
 -- Sigh.  This is a pain.
 
-import TcType          ( tcSplitAppTy, tcSplitFunTys, tcSplitTyConApp_maybe, tcTyConAppArgs,
+import TcType          ( tcSplitAppTy, tcSplitFunTys, tcTyConAppArgs,
                          isIntegerTy, tcSplitTyConApp, isUnLiftedType, Type )
 import Type            ( splitFunTys )
 import CoreSyn
@@ -46,7 +46,7 @@ import DataCon                ( DataCon, dataConWrapId, dataConFieldLabels, dataConInstOrigArg
 import DataCon         ( isExistentialDataCon )
 import Literal         ( Literal(..) )
 import TyCon           ( tyConDataCons )
-import TysWiredIn      ( tupleCon, listTyCon, charDataCon, intDataCon )
+import TysWiredIn      ( tupleCon, charDataCon, intDataCon )
 import BasicTypes      ( RecFlag(..), Boxity(..), ipNameName )
 import Maybes          ( maybeToBool )
 import PrelNames       ( hasKey, ratioTyConKey, toPName )
@@ -454,7 +454,7 @@ dictionaries.
 dsExpr (RecordUpdOut record_expr record_in_ty record_out_ty dicts [])
   = dsExpr record_expr
 
-dsExpr (RecordUpdOut record_expr record_in_ty record_out_ty dicts rbinds)
+dsExpr expr@(RecordUpdOut record_expr record_in_ty record_out_ty dicts rbinds)
   = getSrcLocDs                        `thenDs` \ src_loc ->
     dsExpr record_expr         `thenDs` \ record_expr' ->
 
@@ -488,7 +488,9 @@ dsExpr (RecordUpdOut record_expr record_in_ty record_out_ty dicts rbinds)
                                    src_loc)
     in
        -- Record stuff doesn't work for existentials
-    ASSERT( all (not . isExistentialDataCon) data_cons )
+       -- The type checker checks for this, but we need 
+       -- worry only about the constructors that are to be updated
+    ASSERT2( all (not . isExistentialDataCon) cons_to_upd, ppr expr )
 
        -- It's important to generate the match with matchWrapper,
        -- and the right hand sides with applications of the wrapper Id