From cbedd1ce1a96eb330ad938219f0b52801ce862dc Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Thu, 23 Aug 2012 16:35:11 +0100
Subject: [PATCH] Two small fixes to SpecConstr for functions with
equality-proof args
First, make Rules.match_co able to deal wit some modest coercions
Second, make SpecConstr use wild-card for coercion arguments
This is the rest of the fix for Trac #7165
MERGED from commit b04ff2fe83d8a5f9c176739559ac722521a7bdcc
---
compiler/specialise/Rules.lhs | 7 ++++++-
compiler/specialise/SpecConstr.lhs | 6 ++----
2 files changed, 8 insertions(+), 5 deletions(-)
diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs
index 0cf858e7b51d..231fd27ac65c 100644
--- a/compiler/specialise/Rules.lhs
+++ b/compiler/specialise/Rules.lhs
@@ -725,8 +725,13 @@ match_co :: RuleEnv
-> Maybe RuleSubst
match_co renv subst (CoVarCo cv) co
= match_var renv subst cv (Coercion co)
+match_co renv subst (Refl ty1) co
+ = case co of
+ Refl ty2 -> match_ty renv subst ty1 ty2
+ _ -> Nothing
match_co _ _ co1 _
- = pprTrace "match_co bailing out" (ppr co1) Nothing
+ = pprTrace "match_co: needs more cases" (ppr co1) Nothing
+ -- Currently just deals with CoVarCo and Refl
-------------
rnMatchBndr2 :: RuleEnv -> RuleSubst -> Var -> Var -> RuleEnv
diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index 995d6212ceb2..7661878ac1eb 100644
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -1585,9 +1585,6 @@ argToPat :: ScEnv
argToPat _env _in_scope _val_env arg@(Type {}) _arg_occ
= return (False, arg)
-argToPat _env _in_scope _val_env arg@(Coercion {}) _arg_occ
- = return (False, arg)
-
argToPat env in_scope val_env (Tick _ arg) arg_occ
= argToPat env in_scope val_env arg arg_occ
-- Note [Notes in call patterns]
@@ -1696,6 +1693,7 @@ argToPat env in_scope val_env (Var v) arg_occ
-- We don't want to specialise for that *particular* x,y
-- The default case: make a wild-card
+ -- We use this for coercions too
argToPat _env _in_scope _val_env arg _arg_occ
= wildCardPat (exprType arg)
@@ -1703,7 +1701,7 @@ wildCardPat :: Type -> UniqSM (Bool, CoreArg)
wildCardPat ty
= do { uniq <- getUniqueUs
; let id = mkSysLocal (fsLit "sc") uniq ty
- ; return (False, Var id) }
+ ; return (False, varToCoreExpr id) }
argsToPats :: ScEnv -> InScopeSet -> ValueEnv
-> [CoreArg] -> [ArgOcc] -- Should be same length
--
GitLab