From 4650a8177855fab974062cbe8f17689c1f3c3e9c Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Sat, 28 Feb 1998 12:14:33 +0000
Subject: [PATCH] [project @ 1998-02-28 12:14:33 by sof] Generate a little bit
 less code for record selectors.

---
 ghc/compiler/prelude/StdIdInfo.lhs |   16 ++++++++++++----
 1 file changed, 12 insertions(+), 4 deletions(-)

diff --git a/ghc/compiler/prelude/StdIdInfo.lhs b/ghc/compiler/prelude/StdIdInfo.lhs
index 75d803b..968dc9d 100644
--- a/ghc/compiler/prelude/StdIdInfo.lhs
+++ b/ghc/compiler/prelude/StdIdInfo.lhs
@@ -39,6 +39,7 @@ import TyCon		( isNewTyCon, tyConDataCons, isDataTyCon )
 import FieldLabel	( FieldLabel )
 import PrelVals		( pAT_ERROR_ID )
 import Maybes
+import Maybe            ( isJust )
 import Outputable
 import Util		( assoc )
 \end{code}		
@@ -153,10 +154,17 @@ addStandardIdInfo sel_id
 	tyvar_tys	      = mkTyVarTys tyvars
 	
 	[data_id] = mkTemplateLocals [data_ty]
-	sel_rhs = mkTyLam tyvars $
-		  mkValLam [data_id] $
-		  Case (Var data_id) (AlgAlts (catMaybes (map mk_maybe_alt data_cons))
-					      (BindDefault data_id error_expr))
+        alts      = map mk_maybe_alt data_cons
+	sel_rhs   = mkTyLam tyvars $
+		    mkValLam [data_id] $
+		    Case (Var data_id) 
+		         -- if any of the constructors don't have the label, ...
+			 (if any (not . isJust) alts then
+		           AlgAlts (catMaybes alts) 
+			           (BindDefault data_id error_expr)
+			  else
+			   AlgAlts (catMaybes alts) NoDefault)
+
 	mk_maybe_alt data_con 
 	  = case maybe_the_arg_id of
 		Nothing		-> Nothing
-- 
1.7.10.4