X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Ftypecheck%2FTcCanonical.lhs;fp=compiler%2Ftypecheck%2FTcCanonical.lhs;h=5624fd3f496d1cd15ceae99a8c0dce52d8aefabb;hb=25bff7fe1a22edbafa188af8d844c67057fa5eb8;hp=2331d2d38336d21e8d90933f836c51ad89f9b44f;hpb=02856df2ce1e728930cb96210e79422f34929579;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs index 2331d2d..5624fd3 100644 --- a/compiler/typecheck/TcCanonical.lhs +++ b/compiler/typecheck/TcCanonical.lhs @@ -541,15 +541,19 @@ reOrient _untch (FunCls {}) (VarCls tv2) = isMetaTyVar tv2 reOrient _untch (FunCls {}) _ = False -- Fun/Other on rhs reOrient _untch (VarCls tv1) (FunCls {}) = not $ isMetaTyVar tv1 + -- Put function on the left, *except* if the RHS becomes + -- a meta-tyvar; see invariant on CFunEqCan + -- and Note [No touchables as FunEq RHS] -reOrient _untch (VarCls tv1) (FskCls {}) = not $ isMetaTyVar tv1 - -- See Note [Loopy Spontaneous Solving, Example 4] +reOrient _untch (VarCls tv1) (FskCls {}) = not $ isMetaTyVar tv1 + -- Put flatten-skolems on the left if possible: + -- see Note [Loopy Spontaneous Solving, Example 4] in TcInteract reOrient _untch (VarCls {}) (OtherCls {}) = False reOrient _untch (VarCls {}) (VarCls {}) = False reOrient _untch (FskCls {}) (VarCls tv2) = isMetaTyVar tv2 - -- See Note [Loopy Spontaneous Solving, Example 4] + -- See Note [Loopy Spontaneous Solving, Example 4] in TcInteract reOrient _untch (FskCls {}) (FskCls {}) = False reOrient _untch (FskCls {}) (FunCls {}) = True