diff options
| author | Joachim Breitner <mail@joachim-breitner.de> | 2014-01-24 13:39:11 +0000 |
|---|---|---|
| committer | Joachim Breitner <mail@joachim-breitner.de> | 2014-02-11 15:36:24 +0000 |
| commit | 8f16233c154ab0645c4b90f0e4e98204650811c1 (patch) | |
| tree | 20430ac01e49757d8edce0603ed3237002f8fde2 /compiler | |
| parent | d557d8c34b80a9513b6ea36aeab6453173d83fa3 (diff) | |
| download | haskell-8f16233c154ab0645c4b90f0e4e98204650811c1.tar.gz | |
Add Case TyConAppCo to match_co
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/specialise/Rules.lhs | 25 |
1 files changed, 22 insertions, 3 deletions
diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs index 7fdf12c9c1..4753e8ff36 100644 --- a/compiler/specialise/Rules.lhs +++ b/compiler/specialise/Rules.lhs @@ -730,9 +730,28 @@ match_co renv subst (Refl r1 ty1) co Refl r2 ty2 | r1 == r2 -> match_ty renv subst ty1 ty2 _ -> Nothing -match_co _ _ co1 _ - = pprTrace "match_co: needs more cases" (ppr co1) Nothing - -- Currently just deals with CoVarCo and Refl +match_co renv subst (TyConAppCo r1 tc1 cos1) co2 + = case co2 of + TyConAppCo r2 tc2 cos2 + | r1 == r2 && tc1 == tc2 + -> match_cos renv subst cos1 cos2 + _ -> Nothing +match_co _ _ co1 co2 + = pprTrace "match_co: needs more cases" (ppr co1 $$ ppr co2) Nothing + -- Currently just deals with CoVarCo, TyConAppCo and Refl + +match_cos :: RuleMatchEnv + -> RuleSubst + -> [Coercion] + -> [Coercion] + -> Maybe RuleSubst +match_cos renv subst (co1:cos1) (co2:cos2) = + case match_co renv subst co1 co2 of + Just subst' -> match_cos renv subst' cos1 cos2 + Nothing -> Nothing +match_cos _ subst [] [] = Just subst +match_cos _ _ cos1 cos2 = pprTrace "match_cos: not same length" (ppr cos1 $$ ppr cos2) Nothing + ------------- rnMatchBndr2 :: RuleMatchEnv -> RuleSubst -> Var -> Var -> RuleMatchEnv |