From d8a661e5c6f9749ec66de1801f232694530d9243 Mon Sep 17 00:00:00 2001 From: simonpj Date: Tue, 6 Mar 2001 07:58:43 +0000 Subject: [PATCH] [project @ 2001-03-06 07:58:43 by simonpj] Fix minor bug in SpecConstr; failed to deal with DEFAULT case --- ghc/compiler/specialise/SpecConstr.lhs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/ghc/compiler/specialise/SpecConstr.lhs b/ghc/compiler/specialise/SpecConstr.lhs index d70faf3..59fef91 100644 --- a/ghc/compiler/specialise/SpecConstr.lhs +++ b/ghc/compiler/specialise/SpecConstr.lhs @@ -12,7 +12,7 @@ module SpecConstr( import CoreSyn import CoreLint ( showPass, endPass ) -import CoreUtils ( exprType, exprIsConApp_maybe, eqExpr ) +import CoreUtils ( exprType, eqExpr ) import CoreFVs ( exprsFreeVars ) import DataCon ( dataConRepArity ) import Type ( tyConAppArgs ) @@ -231,7 +231,11 @@ extendBndr env bndr = env { scope = extendVarEnv (scope env) bndr Other } -- case scrut of b -- C x y -> ... -- we want to bind b, and perhaps scrut too, to (C x y) -extendCaseBndr env case_bndr scrut con alt_bndrs +extendCaseBndrs :: ScEnv -> Id -> CoreExpr -> AltCon -> [Var] -> ScEnv +extendCaseBndrs env case_bndr scrut DEFAULT alt_bndrs + = extendBndrs env (case_bndr : alt_bndrs) + +extendCaseBndrs env case_bndr scrut con alt_bndrs = case scrut of Var v -> -- Bind the scrutinee in the ConstrEnv if it's a variable -- Also forget if the scrutinee is a RecArg, because we're @@ -337,7 +341,7 @@ scExpr env (Case scrut b alts) sc_alt (con,bs,rhs) = scExpr env1 rhs `thenUs` \ (usg,rhs') -> returnUs (usg, (con,bs,rhs')) where - env1 = extendCaseBndr env b scrut con bs + env1 = extendCaseBndrs env b scrut con bs scExpr env (Let bind body) = scBind env bind `thenUs` \ (env', bind_usg, bind') -> -- 1.7.10.4