From 30e84fceebee3cf28768b6533f0c1651a351640a Mon Sep 17 00:00:00 2001 From: simonpj Date: Tue, 16 Oct 2001 10:37:32 +0000 Subject: [PATCH] [project @ 2001-10-16 10:37:32 by simonpj] Fix the default-expansion code for HEAD; fixes cg050 --- ghc/compiler/simplCore/SimplUtils.lhs | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs index e53bc04..1dd3ea1 100644 --- a/ghc/compiler/simplCore/SimplUtils.lhs +++ b/ghc/compiler/simplCore/SimplUtils.lhs @@ -885,15 +885,19 @@ mkAlts scrut case_bndr alts@((con1,bndrs1,rhs1) : con_alts) -------------------------------------------------- mkAlts scrut case_bndr alts - | Just (tycon, inst_tys) <- splitTyConApp_maybe (idType case_bndr), - isAlgTyCon tycon, -- It's a data type, tuple, or unboxed tuples. - -- We aren't expecting any newtypes at this point. - (alts_no_deflt, Just rhs) <- findDefault alts, - -- There is a DEFAULT case + | (alts_no_deflt, Just rhs) <- findDefault alts, + -- There is a DEFAULT case + + Just (tycon, inst_tys) <- splitTyConApp_maybe (idType case_bndr), + isAlgTyCon tycon, -- It's a data type, tuple, or unboxed tuples. + not (isNewTyCon tycon), -- We can have a newtype, if we are just doing an eval: + -- case x of { DEFAULT -> e } + -- and we don't want to fill in a default for them! + [missing_con] <- filter is_missing (tyConDataConsIfAvailable tycon) - -- There is just one missing constructor! - = ASSERT( not (isNewTyCon tycon) ) - tick (FillInCaseDefault case_bndr) `thenSmpl_` + -- There is just one missing constructor! + + = tick (FillInCaseDefault case_bndr) `thenSmpl_` getUniquesSmpl `thenSmpl` \ tv_uniqs -> getUniquesSmpl `thenSmpl` \ id_uniqs -> let -- 1.7.10.4