X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FPprExternalCore.lhs;h=e33c7a018eb449eac67955882fcd03333001a376;hb=21eeb926c8bf398e38919429d2375b78be45b14b;hp=c34f7b842a45140ab8df52fd97e657b0dfdfbc4c;hpb=e4417dcd4679da9c6b18c02ff667199c572bed89;p=ghc-hetmet.git diff --git a/compiler/coreSyn/PprExternalCore.lhs b/compiler/coreSyn/PprExternalCore.lhs index c34f7b8..e33c7a0 100644 --- a/compiler/coreSyn/PprExternalCore.lhs +++ b/compiler/coreSyn/PprExternalCore.lhs @@ -5,12 +5,11 @@ \begin{code} module PprExternalCore () where -import ExternalCore import Encoding +import ExternalCore import Pretty -import Char - +import Data.Char instance Show Module where showsPrec _ m = shows (pmodule m) @@ -57,10 +56,7 @@ ptdef (Data tcon tbinds cdefs) = ptdef (Newtype tcon coercion tbinds rep) = text "%newtype" <+> pqname tcon <+> pqname coercion <+> (hsep (map ptbind tbinds)) $$ indent repclause - where repclause = case rep of - Just ty -> char '=' <+> pty ty - Nothing -> empty - + where repclause = char '=' <+> pty rep pcdef :: Cdef -> Doc pcdef (Constr dcon tbinds tys) = @@ -103,6 +99,18 @@ pbty t = paty t pty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = fsep [pbty t1, text "->",pty t2] pty (Tforall tb t) = text "%forall" <+> pforall [tb] t +pty (TransCoercion t1 t2) = + sep [text "%trans", paty t1, paty t2] +pty (SymCoercion t) = + sep [text "%sym", paty t] +pty (UnsafeCoercion t1 t2) = + sep [text "%unsafe", paty t1, paty t2] +pty (LeftCoercion t) = + sep [text "%left", paty t] +pty (RightCoercion t) = + sep [text "%right", paty t] +pty (InstCoercion t1 t2) = + sep [text "%inst", paty t1, paty t2] pty t = pbty t pappty :: Ty -> [Ty] -> Doc