Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-constraint-solver
http://hackage.haskell.org/trac/ghc/changeset/e94e178031a072858595d90bcd006560f2452ae2 >--------------------------------------------------------------- commit e94e178031a072858595d90bcd006560f2452ae2 Author: Dimitrios Vytiniotis <[email protected]> Date: Fri Nov 11 18:37:49 2011 +0000 Small modification in newEvVar, and commentary in TcCanonical. Nothing is really affected. >--------------------------------------------------------------- compiler/typecheck/TcCanonical.lhs | 4 ++++ compiler/typecheck/TcSMonad.lhs | 10 +++++++++- 2 files changed, 13 insertions(+), 1 deletions(-) diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs index aea7b89..4825d73 100644 --- a/compiler/typecheck/TcCanonical.lhs +++ b/compiler/typecheck/TcCanonical.lhs @@ -1044,6 +1044,10 @@ canEqLeafFunEqLeftRec d fl eqv (fn,tys1) ty2 -- eqv :: F tys1 ~ ty2 = do { traceTcS "canEqLeafFunEqLeftRec" $ ppr (evVarPred eqv) ; (xis1,cos1) <- flattenMany d fl tys1 -- Flatten type function arguments -- cos1 :: xis1 ~ tys1 + +-- DV: This needs fixing, use the /inert/ flat equations instead of the flat cache +-- to rewrite the head of the family! TODO TODO TODO + ; let no_flattening = all isReflCo cos1 ; if no_flattening then -- No flattening, just go directly to flatten RHS and continue diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index e70637a..f746748 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -1334,8 +1334,16 @@ updateCache ecache (ev,fl,pty) where classifier = classifyPredType pty ecache' = alterTM pty (\_ -> Just (ev,fl)) $ evc_cache ecache - flat_cache' ty1 ty2 = alterTM ty1 (\_ -> Just (ev,(ty2,fl))) $ + flat_cache' ty1 ty2 = alterTM ty1 x_flat_cache $ evc_flat_cache ecache + where x_flat_cache r -- Even if the original guy can update the ecache + -- maybe we don't want him to update the flat cache! + | Just (_ev',(_,fl')) <- r + , fl' `canRewrite` fl + = r -- Don't do the update! + | otherwise + = Just (ev,(ty2,fl)) + is_function_free ty = go ty where go ty@(TyConApp tc tys) | Just ty' <- tcView ty = go ty' _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
