Max What is going on here?! Pls describe
S | -----Original Message----- | From: [email protected] [mailto:[email protected]] On Behalf Of | Max Bolingbroke | Sent: 10 September 2011 19:07 | To: [email protected] | Subject: [commit: ghc] master: Solve irreducible evidence from itself (a7ac381) | | Repository : ssh://darcs.haskell.org//srv/darcs/ghc | | On branch : master | | http://hackage.haskell.org/trac/ghc/changeset/a7ac3815e025e569af928fd22921c01ab4658a1 | 5 | | >--------------------------------------------------------------- | | commit a7ac3815e025e569af928fd22921c01ab4658a15 | Author: Max Bolingbroke <[email protected]> | Date: Sat Sep 10 14:31:08 2011 +0100 | | Solve irreducible evidence from itself | | >--------------------------------------------------------------- | | compiler/typecheck/TcInteract.lhs | 18 ++++++++++++++---- | 1 files changed, 14 insertions(+), 4 deletions(-) | | diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs | index 29a51ee..7c1bbdd 100644 | --- a/compiler/typecheck/TcInteract.lhs | +++ b/compiler/typecheck/TcInteract.lhs | @@ -871,8 +871,8 @@ interactWithInertsStage depth workItem inert | getISRelevant (CIPCan { cc_ip_nm = nm }) is | = let (relevant, residual_map) = getRelevantCts nm (inert_ips is) | in (relevant, is { inert_ips = residual_map }) | - getISRelevant (CIrredEvCan {}) is -- Irreducible, nothing is relevant! Only | interacts with equalities. | - = (emptyCCan, is) | + getISRelevant (CIrredEvCan {}) is | + = (inert_irreds is, is { inert_irreds = emptyCCan }) | -- An equality, finally, may kick everything except equalities out | -- because we have already interacted the equalities in | interactWithInertEqsStage | getISRelevant _eq_ct is -- Equality, everything is relevant for this one | @@ -1037,8 +1037,8 @@ doInteractWithInert (CDictCan { cc_id = dv, cc_flavor = ifl, | cc_class = cl, cc_t | = do { rewritten_dict <- rewriteDict (eqv,tv,xi) (dv,ifl,cl,xis) | ; mkIRContinue "Cls/Eq" workItem DropInert (workListFromNonEq rewritten_dict) | } | | --- Class constraint and given equality: use the equality to rewrite | --- the class constraint. | +-- Irreducible evidence and given equality: use the equality to rewrite | +-- the irreducible evidence. | doInteractWithInert (CTyEqCan { cc_id = eqv, cc_flavor = ifl, cc_tyvar = tv, cc_rhs | = xi }) | (CIrredEvCan { cc_id = id, cc_flavor = wfl, cc_ty = ty }) | | ifl `canRewrite` wfl | @@ -1053,6 +1053,16 @@ doInteractWithInert (CIrredEvCan { cc_id = id, cc_flavor = | ifl, cc_ty = ty }) | = do { rewritten_irred <- rewriteIrred (eqv,tv,xi) (id,ifl,ty) | ; mkIRContinue "Irred/Eq" workItem DropInert rewritten_irred } | | +-- Two pieces of irreducible evidence: if their types are *exactly identical* we can | +-- rewrite them. We can never improve using this: if we want ty1 :: Constraint and | have | +-- ty2 :: Constraint it clearly does not mean that (ty1 ~ ty2) | +doInteractWithInert (CIrredEvCan { cc_id = id1, cc_flavor = ifl, cc_ty = ty1 }) | + workItem@(CIrredEvCan { cc_ty = ty2 }) | + | ty1 `eqType` ty2 | + = solveOneFromTheOther "Irred/Irred" (EvId id1,ifl) workItem | + | +-- Implicit param and given equality: use the equality to rewrite | +-- the implicit param. | doInteractWithInert (CTyEqCan { cc_id = eqv, cc_flavor = ifl, cc_tyvar = tv, cc_rhs | = xi }) | (CIPCan { cc_id = ipid, cc_flavor = wfl, cc_ip_nm = nm, cc_ip_ty | = ty }) | | ifl `canRewrite` wfl | | | | _______________________________________________ | Cvs-ghc mailing list | [email protected] | http://www.haskell.org/mailman/listinfo/cvs-ghc _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
