[commit: ghc] ghc-new-flavor: Changing the orientation of a generated equality (3f42011)

[dimitris at microsoft.com]

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 <dimitris at microsoft.com>
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"