From b175a192aa060ec461a9755f86ebe37c480f98fe Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Tue, 19 Dec 2000 14:19:24 +0000
Subject: [PATCH] [project @ 2000-12-19 14:19:24 by simonmar] The CafInfo on a
 record selector may in fact need to be MayHaveCafRefs, if
 the record selector in question has a default failure case
 that calls recSelError.

Thanks to the ASSERT in SRT.lhs, this was caught before it could do
any real damage.
---
 ghc/compiler/basicTypes/MkId.lhs |   12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index 45f4f00..0676935 100644
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -429,7 +429,7 @@ mkRecordSelId tycon field_label unpack_id unpackUtf8_id
 		   mkFunTy data_ty field_tau
       
     arity = 1 + n_dict_tys + n_field_dict_tys
-    info = mkIdInfo (RecordSelId field_label) NoCafRefs
+    info = mkIdInfo (RecordSelId field_label) caf_info
 	   `setArityInfo`	exactArity arity
 	   `setUnfoldingInfo`	unfolding	
            `setTyGenInfo`	TyGenNever
@@ -445,8 +445,14 @@ mkRecordSelId tycon field_label unpack_id unpackUtf8_id
 
     alts      = map mk_maybe_alt data_cons
     the_alts  = catMaybes alts
-    default_alt | all isJust alts = []	-- No default needed
-		| otherwise	  = [(DEFAULT, [], error_expr)]
+
+    no_default = all isJust alts	-- No default needed
+    default_alt | no_default = []
+		| otherwise  = [(DEFAULT, [], error_expr)]
+
+	-- the default branch may have CAF refs, because it calls recSelError etc.
+    caf_info    | no_default = NoCafRefs
+	        | otherwise  = MayHaveCafRefs
 
     sel_rhs = mkLams tyvars   $ mkLams field_tyvars $ 
 	      mkLams dict_ids $ mkLams field_dict_ids $
-- 
1.7.10.4