From: simonpj <unknown>
Date: Wed, 24 Apr 2002 11:06:11 +0000 (+0000)
Subject: [project @ 2002-04-24 11:06:10 by simonpj]
X-Git-Tag: Approx_11550_changesets_converted~2104
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=139f7fce78199a2cade6cef97042ebfc25a34f86;hp=d6406966932bbee4d75bd267d4df282d44124063;p=ghc-hetmet.git

[project @ 2002-04-24 11:06:10 by simonpj]
Fix an obscure corner situation in case-simplification (cg051)
---

diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs
index 90151b9..1d9b987 100644
--- a/ghc/compiler/simplCore/SimplUtils.lhs
+++ b/ghc/compiler/simplCore/SimplUtils.lhs
@@ -861,6 +861,16 @@ prepareDefault case_bndr handled_cons (Just rhs)
 				-- 	case x of { DEFAULT -> e }
 				-- and we don't want to fill in a default for them!
     Just all_cons <- tyConDataCons_maybe tycon,
+    not (null all_cons),	-- This is a tricky corner case.  If the data type has no constructors,
+				-- which GHC allows, then the case expression will have at most a default
+				-- alternative.  We don't want to eliminate that alternative, because the
+				-- invariant is that there's always one alternative.  It's more convenient
+				-- to leave	
+				--	case x of { DEFAULT -> e }     
+				-- as it is, rather than transform it to
+				--	error "case cant match"
+				-- which would be quite legitmate.  But it's a really obscure corner, and
+				-- not worth wasting code on.
     let handled_data_cons = [data_con | DataAlt data_con <- handled_cons],
     let missing_cons      = [con | con <- all_cons, 
 			           not (con `elem` handled_data_cons)]
@@ -1170,6 +1180,16 @@ I don't really know how to improve this situation.
 
 \begin{code}
 --------------------------------------------------
+--	0. Check for empty alternatives
+--------------------------------------------------
+
+#ifdef DEBUG
+mkCase1 scrut case_bndr []
+  = pprTrace "mkCase1: null alts" (ppr case_bndr <+> ppr scrut) $
+    returnSmpl scrut
+#endif
+
+--------------------------------------------------
 --	1. Eliminate the case altogether if poss
 --------------------------------------------------
 
@@ -1215,12 +1235,6 @@ mkCase1 scrut case_bndr [(con,bndrs,rhs)]
 --	2. Identity case
 --------------------------------------------------
 
-#ifdef DEBUG
-mkCase1 scrut case_bndr []
-  = pprTrace "mkCase1: null alts" (ppr case_bndr <+> ppr scrut) $
-    returnSmpl scrut
-#endif
-
 mkCase1 scrut case_bndr alts	-- Identity case
   | all identity_alt alts
   = tick (CaseIdentity case_bndr)		`thenSmpl_`
diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 5cae204..0a61418 100644
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -1240,7 +1240,7 @@ rebuildCase env scrut case_bndr alts cont
 
   | otherwise
   = prepareAlts scrut case_bndr alts		`thenSmpl` \ (better_alts, handled_cons) -> 
-
+	
 	-- Deal with the case binder, and prepare the continuation;
 	-- The new subst_env is in place
     prepareCaseCont env better_alts cont	`thenSmpl` \ (floats, (dup_cont, nondup_cont)) ->