Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/6761dc2509de8b7f6b9f6f847d1e22f7a1849a79 >--------------------------------------------------------------- commit 6761dc2509de8b7f6b9f6f847d1e22f7a1849a79 Author: Simon Peyton Jones <simo...@microsoft.com> Date: Wed Jan 2 16:39:54 2013 +0000 Add an extra error check in DEBUG mode for ill-typed unfoldings >--------------------------------------------------------------- compiler/simplCore/Simplify.lhs | 12 +++++++++--- 1 files changed, 9 insertions(+), 3 deletions(-) diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index af93f58..88f46f4 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -2069,16 +2069,22 @@ addAltUnfoldings env scrut case_bndr con_app -- See Note [Add unfolding for scrutinee] env2 = case scrut of - Just (Var v) -> addBinderUnfolding env1 v con_app_unf - Just (Cast (Var v) co) -> addBinderUnfolding env1 v $ + Just (Var v) -> addBinderUnfolding env1 v con_app_unf + Just (Cast (Var v) co) -> addBinderUnfolding env1 v $ mkSimpleUnfolding dflags (Cast con_app (mkSymCo co)) - _ -> env1 + _ -> env1 ; traceSmpl "addAltUnf" (vcat [ppr case_bndr <+> ppr scrut, ppr con_app]) ; return env2 } addBinderUnfolding :: SimplEnv -> Id -> Unfolding -> SimplEnv addBinderUnfolding env bndr unf + | debugIsOn, Just tmpl <- maybeUnfoldingTemplate unf + = WARN( not (eqType (idType bndr) (exprType tmpl)), + ppr bndr $$ ppr (idType bndr) $$ ppr tmpl $$ ppr (exprType tmpl) ) + modifyInScope env (bndr `setIdUnfolding` unf) + + | otherwise = modifyInScope env (bndr `setIdUnfolding` unf) zapBndrOccInfo :: Bool -> Id -> Id _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
