Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-constraint-solver
http://hackage.haskell.org/trac/ghc/changeset/8f0f1908fa52a3c784e21bf99a74cc0d44f5571e >--------------------------------------------------------------- commit 8f0f1908fa52a3c784e21bf99a74cc0d44f5571e Author: Simon Peyton Jones <[email protected]> Date: Wed Oct 26 18:03:23 2011 +0100 Fix infinite loop in printing coercion ((->) x) >--------------------------------------------------------------- compiler/types/Coercion.lhs | 21 ++++++++++----------- 1 files changed, 10 insertions(+), 11 deletions(-) diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index baaff2a..c4cddc6 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -133,6 +133,7 @@ data Coercion | TyConAppCo TyCon [Coercion] -- lift TyConApp -- The TyCon is never a synonym; -- we expand synonyms eagerly + -- But it can be a type function | AppCo Coercion Coercion -- lift AppTy @@ -380,20 +381,16 @@ pprParendCo co = ppr_co TyConPrec co ppr_co :: Prec -> Coercion -> SDoc ppr_co _ (Refl ty) = angles (ppr ty) -ppr_co p co@(TyConAppCo tc cos) +ppr_co p co@(TyConAppCo tc [_,_]) | tc `hasKey` funTyConKey = ppr_fun_co p co - | otherwise = pprTcApp p ppr_co tc cos - -ppr_co p (AppCo co1 co2) = maybeParen p TyConPrec $ - pprCo co1 <+> ppr_co TyConPrec co2 - -ppr_co p co@(ForAllCo {}) = ppr_forall_co p co - -ppr_co _ (CoVarCo cv) = parenSymOcc (getOccName cv) (ppr cv) +ppr_co p (TyConAppCo tc cos) = pprTcApp p ppr_co tc cos +ppr_co p (AppCo co1 co2) = maybeParen p TyConPrec $ + pprCo co1 <+> ppr_co TyConPrec co2 +ppr_co p co@(ForAllCo {}) = ppr_forall_co p co +ppr_co _ (CoVarCo cv) = parenSymOcc (getOccName cv) (ppr cv) ppr_co p (AxiomInstCo con cos) = pprTypeNameApp p ppr_co (getName con) cos - ppr_co p (TransCo co1 co2) = maybeParen p FunPrec $ ppr_co FunPrec co1 <+> ptext (sLit ";") @@ -401,7 +398,8 @@ ppr_co p (TransCo co1 co2) = maybeParen p FunPrec $ ppr_co p (InstCo co ty) = maybeParen p TyConPrec $ pprParendCo co <> ptext (sLit "@") <> pprType ty -ppr_co p (UnsafeCo ty1 ty2) = pprPrefixApp p (ptext (sLit "UnsafeCo")) [pprParendType ty1, pprParendType ty2] +ppr_co p (UnsafeCo ty1 ty2) = pprPrefixApp p (ptext (sLit "UnsafeCo")) + [pprParendType ty1, pprParendType ty2] ppr_co p (SymCo co) = pprPrefixApp p (ptext (sLit "Sym")) [pprParendCo co] ppr_co p (NthCo n co) = pprPrefixApp p (ptext (sLit "Nth:") <+> int n) [pprParendCo co] @@ -412,6 +410,7 @@ angles p = char '<' <> p <> char '>' ppr_fun_co :: Prec -> Coercion -> SDoc ppr_fun_co p co = pprArrowChain p (split co) where + split :: Coercion -> [SDoc] split (TyConAppCo f [arg,res]) | f `hasKey` funTyConKey = ppr_co FunPrec arg : split res _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
