[commit: ghc] master: Improve orientation (a836b69)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/a836b69c4888e5e1cf9a7d988f0dce888b1f6816/ghc

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

commit a836b69c4888e5e1cf9a7d988f0dce888b1f6816
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Nov 15 18:46:57 2013 +0000

    Improve orientation
    
    I came across some stupid re-orientation, when debugging something else.
    For example, we were re-orienting
    
        t ~ fsk
    to
       fsk ~ t
    where fsk is a flatten *skolem* and t is a meta type varaible.
    The logic was just wrong.


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

a836b69c4888e5e1cf9a7d988f0dce888b1f6816
 compiler/typecheck/TcCanonical.lhs |   15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs
index 8978878..cc3c042 100644
--- a/compiler/typecheck/TcCanonical.lhs
+++ b/compiler/typecheck/TcCanonical.lhs
@@ -1008,15 +1008,18 @@ reOrient (FunCls {}) _      = False             -- Fun/Other on rhs
 reOrient (VarCls {})   (FunCls {})           = True
 reOrient (VarCls {})   (OtherCls {})         = False
 reOrient (VarCls tv1)  (VarCls tv2)
-  | not (k2 `isSubKind` k1),   k1 `isSubKind` k2   = True  -- Note [Kind orientation for CTyEqCan]
-                                                           -- in TcRnTypes
-  | not (isMetaTyVar tv1),     isMetaTyVar     tv2 = True
-  | not (isFlatSkolTyVar tv1), isFlatSkolTyVar tv2 = True  -- Note [Eliminate flat-skols]
-  | otherwise                                      = False
+  | k1 `eqKind` k2      = tv2 `better_than` tv1
+  | k1 `isSubKind` k2   = True  -- Note [Kind orientation for CTyEqCan]
+  | otherwise           = False -- in TcRnTypes
   where
     k1 = tyVarKind tv1
     k2 = tyVarKind tv2
-  -- Just for efficiency, see CTyEqCan invariants
+
+    tv2 `better_than` tv1
+      | isMetaTyVar tv1     = False   -- Never swap a meta-tyvar
+      | isFlatSkolTyVar tv1 = isMetaTyVar tv2
+      | otherwise           = isMetaTyVar tv1 || isFlatSkolTyVar tv2
+                                      -- Note [Eliminate flat-skols]
 
 ------------------