Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-new-flavor
http://hackage.haskell.org/trac/ghc/changeset/d3020a70517f503a4da6abb4ca19be962e7d8b6c >--------------------------------------------------------------- commit d3020a70517f503a4da6abb4ca19be962e7d8b6c Author: Dimitrios.Vytiniotis <[email protected]> Date: Wed Apr 4 14:38:26 2012 +0100 Adding a forgotten pre-canonicalication cache-lookup stage. >--------------------------------------------------------------- compiler/typecheck/TcInteract.lhs | 22 +++++++++++++++++++++- compiler/typecheck/TcSMonad.lhs | 2 +- 2 files changed, 22 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs index 1887399..42b4f74 100644 --- a/compiler/typecheck/TcInteract.lhs +++ b/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 ---------------------------------------------------------- diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index 650d382..4c53dc4 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/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, _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
