From b7aa1a08693f2b9b7c2ac9451b7be64f66f88be1 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Tue, 10 Nov 2009 17:17:45 +0000 Subject: [PATCH] Implement the PushC rule when optimising casts --- compiler/simplCore/Simplify.lhs | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index f8462be..6ae9587 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -942,14 +942,19 @@ simplCast env body co0 cont0 add_coerce co (s1s2, _t1t2) (ApplyTo dup (Type arg_ty) arg_se cont) -- (f |> g) ty ---> (f ty) |> (g @ ty) - -- This implements the PushT rule from the paper + -- This implements the PushT and PushC rules from the paper | Just (tyvar,_) <- splitForAllTy_maybe s1s2 - , not (isCoVar tyvar) - = ApplyTo dup (Type ty') (zapSubstEnv env) (addCoerce (mkInstCoercion co ty') cont) + = let + (new_arg_ty, new_cast) + | isCoVar tyvar = (new_arg_co, mkCselRCoercion co) -- PushC rule + | otherwise = (ty', mkInstCoercion co ty') -- PushT rule + in + ApplyTo dup (Type new_arg_ty) (zapSubstEnv env) (addCoerce new_cast cont) where ty' = substTy (arg_se `setInScope` env) arg_ty - - -- ToDo: the PushC rule is not implemented at all + new_arg_co = mkCsel1Coercion co `mkTransCoercion` + ty' `mkTransCoercion` + mkSymCoercion (mkCsel2Coercion co) add_coerce co (s1s2, _t1t2) (ApplyTo dup arg arg_se cont) | not (isTypeArg arg) -- This implements the Push rule from the paper -- 1.7.10.4