Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-new-flavor
http://hackage.haskell.org/trac/ghc/changeset/3f420118322c6436a8772536bafe15e54c2e0987 >--------------------------------------------------------------- commit 3f420118322c6436a8772536bafe15e54c2e0987 Author: Dimitrios Vytiniotis <[email protected]> Date: Thu Mar 29 17:25:01 2012 +0200 Changing the orientation of a generated equality >--------------------------------------------------------------- compiler/typecheck/TcInteract.lhs | 37 ++++++++++++++++++++++++++----------- 1 files changed, 26 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs index c0f59f6..d8a59ed 100644 --- a/compiler/typecheck/TcInteract.lhs +++ b/compiler/typecheck/TcInteract.lhs @@ -297,8 +297,6 @@ Case 1: In Rewriting Equalities (function rewriteEqLHS) canonicalize (xi1 ~ xi2) if (b) comes from the inert set, or (xi2 ~ xi1) if (a) comes from the inert set. - This choice is implemented using the WhichComesFromInert flag. - Case 2: Functional Dependencies Again, we should prefer, if possible, the inert variables on the RHS @@ -974,15 +972,36 @@ doInteractWithInert ii@(CFunEqCan { cc_flavor = fl1, cc_fun = tc1 = irWorkItemConsumed "FunEq/FunEq" | fl1 `canSolve` fl2 && lhss_match = do { traceTcS "interact with inerts: FunEq/FunEq" $ - vcat [ text "workitem =" <+> ppr wi - , text "inertitem=" <+> ppr ii ] + vcat [ text "workItem =" <+> ppr wi + , text "inertItem=" <+> ppr ii ] + + ; let xev = XEvTerm xcomp xdecomp + -- xcomp : [(xi2 ~ xi1)] -> (F args ~ xi2) + xcomp [x] = EvCoercion (co1 `mkTcTransCo` mk_sym_co x) + xcomp _ = panic "No more goals!" + -- xdecomp : (F args ~ xi2) -> [(xi2 ~ xi1)] + xdecomp x = [EvCoercion (mk_sym_co x `mkTcTransCo` co1)] - ; xCtFlavor_cache False fl2 [mkTcEqPred xi2 xi1] (xev co1) $ what_next d2 + ; xCtFlavor_cache False fl2 [mkTcEqPred xi2 xi1] xev $ what_next d2 -- Why not simply xCtFlavor? See Note [Cache-caused loops] + -- Why not (mkTcEqPred xi1 xi2)? See Note [Efficient orientation] ; irWorkItemConsumed "FunEq/FunEq" } | fl2 `canSolve` fl1 && lhss_match - = do { xCtFlavor_cache False fl1 [mkTcEqPred xi1 xi2] (xev co2) $ what_next d1 - -- Why not simply xCtFlavor? See Note [Cache-caused loops] + = do { traceTcS "interact with inerts: FunEq/FunEq" $ + vcat [ text "workItem =" <+> ppr wi + , text "inertItem=" <+> ppr ii ] + + ; let xev = XEvTerm xcomp xdecomp + -- xcomp : [(xi2 ~ xi1)] -> [(F args ~ xi1)] + xcomp [x] = EvCoercion (co2 `mkTcTransCo` mkTcCoVarCo x) + xcomp _ = panic "No more goals!" + -- xdecomp : (F args ~ xi1) -> [(xi2 ~ xi1)] + xdecomp x = [EvCoercion (mkTcSymCo co2 `mkTcTransCo` mkTcCoVarCo x)] + + ; xCtFlavor_cache False fl1 [mkTcEqPred xi2 xi1] xev $ what_next d1 + -- Why not simply xCtFlavor? See Note [Cache-caused loops] + -- Why not (mkTcEqPred xi1 xi2)? See Note [Efficient orientation] + ; irInertConsumed "FunEq/FunEq"} where lhss_match = tc1 == tc2 && eqTypes args1 args2 @@ -993,10 +1012,6 @@ doInteractWithInert ii@(CFunEqCan { cc_flavor = fl1, cc_fun = tc1 co1 = mkTcCoVarCo $ flav_evar fl1 co2 = mkTcCoVarCo $ flav_evar fl2 mk_sym_co x = mkTcSymCo (mkTcCoVarCo x) - xev co = XEvTerm xcomp xdecomp - where xdecomp x = [EvCoercion (mk_sym_co x `mkTcTransCo` co)] - xcomp [x] = EvCoercion (co `mkTcTransCo` mk_sym_co x) - xcomp _ = panic "No more goals!" doInteractWithInert _ _ = irKeepGoing "NOP" _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
