X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FPprExternalCore.lhs;h=5303b0d1b68ffed31265e510bf9547e3c116a907;hp=25394e2bf4cc41c9689b47731eddb9afd4109147;hb=fdf8656855d26105ff36bdd24d41827b05037b91;hpb=391a3e9c08c470bd1444cba2e5111e253c19ea84 diff --git a/compiler/coreSyn/PprExternalCore.lhs b/compiler/coreSyn/PprExternalCore.lhs index 25394e2..5303b0d 100644 --- a/compiler/coreSyn/PprExternalCore.lhs +++ b/compiler/coreSyn/PprExternalCore.lhs @@ -9,7 +9,8 @@ import Encoding import ExternalCore import Pretty -import Char +import Data.Char +import Data.Ratio instance Show Module where showsPrec _ m = shows (pmodule m) @@ -56,10 +57,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) = @@ -108,10 +106,8 @@ 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 (NthCoercion n t) = + sep [text "%nth", int n, paty t] pty (InstCoercion t1 t2) = sep [text "%inst", paty t1, paty t2] pty t = pbty t @@ -191,9 +187,12 @@ palt (Adefault e) = plit :: Lit -> Doc plit (Lint i t) = parens (integer i <> text "::" <> pty t) --- we use (text (show r)) because "(rational r)" was printing out things --- like "2.0e-2" (which isn't External Core) -plit (Lrational r t) = parens (text (show r) <> text "::" <> pty t) +-- we use (text (show (numerator r))) (and the same for denominator) +-- because "(rational r)" was printing out things like "2.0e-2" (which +-- isn't External Core), and (text (show r)) was printing out things +-- like "((-1)/5)" which isn't either (it should be "(-1/5)"). +plit (Lrational r t) = parens (text (show (numerator r)) <+> char '%' + <+> text (show (denominator r)) <> text "::" <> pty t) plit (Lchar c t) = parens (text ("\'" ++ escape [c] ++ "\'") <> text "::" <> pty t) plit (Lstring s t) = parens (pstring s <> text "::" <> pty t)