Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : supercompiler
http://hackage.haskell.org/trac/ghc/changeset/ffbcbda696be3c74e28381a4d499c10271f7bd22 >--------------------------------------------------------------- commit ffbcbda696be3c74e28381a4d499c10271f7bd22 Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Thu May 10 10:22:11 2012 +0100 Whitespace only >--------------------------------------------------------------- compiler/supercompile/Supercompile/Drive/MSG.hs | 3 ++- 1 files changed, 2 insertions(+), 1 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/MSG.hs b/compiler/supercompile/Supercompile/Drive/MSG.hs index 681964e..b3e2191 100644 --- a/compiler/supercompile/Supercompile/Drive/MSG.hs +++ b/compiler/supercompile/Supercompile/Drive/MSG.hs @@ -186,7 +186,7 @@ msgPend rn2 x0 pending = MSG $ \e s0 -> case lookupUpdatePending s0 of lookupUpdatePending s = case pending of -- TODO: binder matching can legitimately fail, in which case we might want to create a common "vanilla" -- binder with no non-MSGable info, leaving the non-unifiable specs/rules to the generalised versions? - PendingVar x_l x_r -> fmapLeft (\upd -> (if x_l == x_r then Just x_r else Nothing, \x -> msgBndrExtras rn2 x x_l x_r, \x -> s { msgKnownPendingVars = upd x })) $ lookupUpdateVE (msgKnownPendingVars s) x_l x_r + PendingVar x_l x_r -> fmapLeft (\upd -> (if x_l == x_r then Just x_r else Nothing, \x -> msgBndrExtras rn2 x x_l x_r, \x -> s { msgKnownPendingVars = upd x })) $ lookupUpdateVE (msgKnownPendingVars s) x_l x_r PendingType ty_l ty_r -> fmapLeft (\upd -> (Nothing, \a -> liftM (a `setTyVarKind`) $ msgKind rn2 (typeKind ty_l) (typeKind ty_r), \a -> s { msgKnownPendingTypes = upd a })) $ lookupUpdateTM (msgKnownPendingTypes s) ty_l ty_r PendingCoercion co_l co_r -> fmapLeft (\upd -> (Nothing, \q -> liftM (q `setVarType`) $ msgType rn2 (coercionType co_l) (coercionType co_r), \q -> s { msgKnownPendingCoercions = upd q })) $ lookupUpdateTM (msgKnownPendingCoercions s) co_l co_r PendingTerm e_l e_r -> Left (Nothing, \x -> liftM (x `setVarType`) $ msgType rn2 (termType e_l) (termType e_r), \_ -> s) @@ -792,6 +792,7 @@ msgBndrExtras rn2 v v_l v_r msgTyVarBndrExtras :: RnEnv2 -> TyVar -> TyVar -> TyVar -> MSG TyVar msgTyVarBndrExtras rn2 a a_l a_r = liftM (a `setTyVarKind`) $ msgKind rn2 (tyVarKind a_l) (tyVarKind a_r) + -- We have to be careful to msg the "fragile" IdInfo for binders as well as the obvious type information msgIdCoVarBndrExtras :: RnEnv2 -> Id -> Id -> Id -> MSG Id msgIdCoVarBndrExtras rn2 x x_l x_r = liftM3 (\unf spec ty -> x `setVarType` ty `setIdUnfolding` unf `setIdSpecialisation` spec) _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
