[project @ 2000-04-20 10:56:05 by simonpj]

- Fix bug in TcExpr.tcMonoExpr (RecordUpd ...), where I hadn't
  propagated the recent change (to be H98ish) that record selectors
  for types with a context are overloaded:
	data Eq a => T a { f1 :: a }

  Here	f1 :: Eq a => T a -> a

  I don't like this, but Mark persuaded me that this was the
  Right Thing if we are to have contexts in data decls at all
  (which we should not)

diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
index e1023c2..ea1eeeb 100644 (file)
--- a/ghc/compiler/deSugar/DsExpr.lhs
+++ b/ghc/compiler/deSugar/DsExpr.lhs
@@ -32,7 +32,7 @@ import Match          ( matchWrapper, matchSimply )
 import CostCentre      ( mkUserCC )
 import FieldLabel      ( FieldLabel )
 import Id              ( Id, idType, recordSelectorFieldLabel )
-import DataCon         ( DataCon, dataConId, dataConTyCon, dataConArgTys, dataConFieldLabels )
+import DataCon         ( DataCon, dataConWrapId, dataConTyCon, dataConArgTys, dataConFieldLabels )
 import PrelInfo                ( rEC_CON_ERROR_ID, rEC_UPD_ERROR_ID, iRREFUT_PAT_ERROR_ID, addr2IntegerId )
 import TyCon           ( isNewTyCon )
 import DataCon         ( isExistentialDataCon )
@@ -507,7 +507,7 @@ dsExpr (RecordUpdOut record_expr record_out_ty dicts rbinds)
            let 
                val_args = zipWithEqual "dsExpr:RecordUpd" mk_val_arg
                                        (dataConFieldLabels con) arg_ids
-               rhs = foldl HsApp (DictApp (TyApp (HsVar (dataConId con)) 
+               rhs = foldl HsApp (DictApp (TyApp (HsVar (dataConWrapId con)) 
                                                  out_inst_tys)
                                           dicts)
                                  val_args

diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index 8063961..100a838 100644 (file)
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -57,8 +57,8 @@ import Name           ( Name, getName )
 import Type            ( mkFunTy, mkAppTy, mkTyVarTy, mkTyVarTys,
                          ipName_maybe,
                          splitFunTy_maybe, splitFunTys, isNotUsgTy,
-                         mkTyConApp,
-                         splitForAllTys, splitRhoTy,
+                         mkTyConApp, splitSigmaTy, 
+                         splitRhoTy,
                          isTauTy, tyVarsOfType, tyVarsOfTypes, 
                          isForAllTy, splitAlgTyConApp, splitAlgTyConApp_maybe,
                          boxedTypeKind, mkArrowKind,
@@ -562,8 +562,9 @@ tcMonoExpr expr@(RecordUpd record_expr rbinds) res_ty
        -- Figure out the tycon and data cons from the first field name
     let
        (Just sel_id : _)         = maybe_sel_ids
-       (_, tau)                  = ASSERT( isNotUsgTy (idType sel_id) )
-                                    splitForAllTys (idType sel_id)
+       (_, _, tau)               = ASSERT( isNotUsgTy (idType sel_id) )
+                                    splitSigmaTy (idType sel_id)       -- Selectors can be overloaded
+                                                                       -- when the data type has a context
        Just (data_ty, _)         = splitFunTy_maybe tau        -- Must succeed since sel_id is a selector
        (tycon, _, data_cons)     = splitAlgTyConApp data_ty
        (con_tyvars, theta, _, _, _, _) = dataConSig (head data_cons)