Adding a forgotten pre-canonicalication cache-lookup stage.

compiler/typecheck/TcInteract.lhs

@@ -208,7 +208,8 @@ React with (F Int ~ b) ==> IR Stop True []    -- after substituting we re-canoni
 
 \begin{code}
 thePipeline :: [(String,SimplifierStage)]
-thePipeline = [ ("canonicalization",        canonicalizationStage)
+thePipeline = [ ("lookup-in-inerts",        lookupInInertsStage)
+              , ("canonicalization",        canonicalizationStage)
               , ("spontaneous solve",       spontaneousSolveStage)
               , ("interact with inerts",    interactWithInertsStage)
               , ("top-level reactions",     topReactionsStage) ]
@@ -217,6 +218,25 @@ thePipeline = [ ("canonicalization",        canonicalizationStage)
 
 \begin{code}
 
+-- A quick lookup everywhere to see if we know about this constraint
+--------------------------------------------------------------------
+lookupInInertsStage :: SimplifierStage
+lookupInInertsStage ct
+  | isWantedCt ct
+  = do { is <- getTcSInerts
+       ; ctxt <- getTcSContext
+       ; case lookupInInerts is (ctPred ct) of
+           Just ct_cached 
+             | (not $ isDerivedCt ct) && (not $ simplEqsOnly ctxt) 
+               -- Don't share if we are simplifying a RULE 
+               -- see Note [Simplifying RULE lhs constraints]
+             -> setEvBind (ctId ct) (EvId (ctId ct_cached)) >> 
+                return Stop
+           _ -> continueWith ct }
+  | otherwise -- I could do something like that for givens 
+              -- as well I suppose but it is not a big deal
+  = continueWith ct
+
 
 -- The canonicalization stage, see TcCanonical for details
 ----------------------------------------------------------

compiler/typecheck/TcSMonad.lhs

@@ -65,7 +65,7 @@ module TcSMonad (
         -- Inerts 
     InertSet(..), InertCans(..), 
     getInertEqs, getCtCoercion,
-    emptyInert, getTcSInerts, updInertSet, extractUnsolved,
+    emptyInert, getTcSInerts, lookupInInerts, updInertSet, extractUnsolved,
     extractUnsolvedTcS, modifyInertTcS,
     updInertSetTcS, partitionCCanMap, partitionEqMap,
     getRelevantCts, extractRelevantInerts,