X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FSimplCase.lhs;h=99e34ab6349a6bdf71b76fb5836ae816520c8d3d;hb=e47dd5d2e5e6dadec89fd0c36d53a14e686dcbfa;hp=0e80f1ea1b6a5053fb9bc080dae00aa8e9544581;hpb=23c8ca46f1b871eff2ecd65d71806ec03684ce2e;p=ghc-hetmet.git diff --git a/ghc/compiler/simplCore/SimplCase.lhs b/ghc/compiler/simplCore/SimplCase.lhs index 0e80f1e..99e34ab 100644 --- a/ghc/compiler/simplCore/SimplCase.lhs +++ b/ghc/compiler/simplCore/SimplCase.lhs @@ -1,4 +1,4 @@ -`% +% % (c) The AQUA Project, Glasgow University, 1994-1996 % \section[SimplCase]{Simplification of `case' expression} @@ -37,6 +37,7 @@ import TyCon ( isDataTyCon ) import TysPrim ( voidTy ) import Util ( Eager, runEager, appEager, isIn, isSingleton, zipEqual, panic, assertPanic ) +import Outputable \end{code} Float let out of case. @@ -685,7 +686,7 @@ completeAlgCaseWithKnownCon -> (SimplEnv -> InExpr -> SmplM OutExpr) -- Rhs handler -> SmplM OutExpr -completeAlgCaseWithKnownCon env con con_args (AlgAlts alts deflt) rhs_c +completeAlgCaseWithKnownCon env con con_args a@(AlgAlts alts deflt) rhs_c = ASSERT(isDataCon con) search_alts alts where @@ -709,7 +710,8 @@ completeAlgCaseWithKnownCon env con con_args (AlgAlts alts deflt) rhs_c = -- No matching alternative case deflt of NoDefault -> -- Blargh! - panic "completeAlgCaseWithKnownCon: No matching alternative and no default" + pprPanic "completeAlgCaseWithKnownCon: No matching alternative and no default" + (ppr con <+> ppr con_args $$ ppr a) BindDefault binder@(_,occ_info) rhs -> -- OK, there's a default case -- let-bind the binder to the constructor