From: simonpj@microsoft.com <unknown>
Date: Wed, 20 Oct 2010 13:24:38 +0000 (+0000)
Subject: Comments and layout only
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=25bff7fe1a22edbafa188af8d844c67057fa5eb8

Comments and layout only
---

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 
diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs
index 5285435..cb9d342 100644
--- a/compiler/typecheck/TcInteract.lhs
+++ b/compiler/typecheck/TcInteract.lhs
@@ -531,16 +531,20 @@ spontaneousSolveStage workItem inerts
                            , sr_stop       = ContinueWith workItem }
 
            Just (workItem', workList')
-               | not (isGivenCt workItem) -- Original was wanted or derived but we have now made him 
-                                          -- given so we have to interact him with the inerts due to
-                                          -- its status change. This in turn may produce more work.
-                   -> do { (new_inert, new_work) <- runSolverPipeline [ ("recursive interact with inert eqs", interactWithInertEqsStage)
-                                                                      , ("recursive interact with inerts", interactWithInertsStage)
-                                                                      ] inerts workItem'
-                         ; return $ SR { sr_new_work = new_work `unionWorkLists` workList'
+               | not (isGivenCt workItem) 
+	       	 -- Original was wanted or derived but we have now made him 
+                 -- given so we have to interact him with the inerts due to
+                 -- its status change. This in turn may produce more work.
+		 -- We do this *right now* (rather than just putting workItem'
+		 -- back into the work-list) because we've solved 
+               -> do { (new_inert, new_work) <- runSolverPipeline 
+                             [ ("recursive interact with inert eqs", interactWithInertEqsStage)
+                             , ("recursive interact with inerts", interactWithInertsStage)
+                             ] inerts workItem'
+                     ; return $ SR { sr_new_work = new_work `unionWorkLists` workList'
                                        , sr_inerts   = new_inert -- will include workItem' 
                                        , sr_stop     = Stop }
-                         }
+                     }
                | otherwise 
                    -> -- Original was given; he must then be inert all right, and
                       -- workList' are all givens from flattening
diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs
index d558e69..416ac80 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -152,11 +152,11 @@ data CanonicalCt
        --   * tv not in tvs(xi)   (occurs check)
        --   * If constraint is given then typeKind xi `compatKind` typeKind tv 
        --                See Note [Spontaneous solving and kind compatibility] 
-       --   * if @xi@ is a flatten skolem then @tv@ can only be: 
+       --   * If 'xi' is a flatten skolem then 'tv' can only be: 
        --              - a flatten skolem or a unification variable
        --     i.e. equalities prefer flatten skolems in their LHS 
-       --                See Note [Loopy Spontaneous Solving, Example 4]
-       --                Also related to [Flatten Skolem Equivalence Classes]
+       --     See Note [Loopy Spontaneous Solving, Example 4]
+       --     Also related to [Flatten Skolem Equivalence Classes]
       cc_id     :: EvVar, 
       cc_flavor :: CtFlavor, 
       cc_tyvar  :: TcTyVar,