[commit: ghc] master: Two small fixes to SpecConstr for functions with equality-proof args (b04ff2f)

[Simon Peyton Jones]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/b04ff2fe83d8a5f9c176739559ac722521a7bdcc

>---------------------------------------------------------------

commit b04ff2fe83d8a5f9c176739559ac722521a7bdcc
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Aug 23 16:35:11 2012 +0100

    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

>---------------------------------------------------------------

 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 0cf858e..231fd27 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 995d621..7661878 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