X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FPprExternalCore.lhs;h=1d4e954de6b937b99908f05dafbbf2bafbe1850e;hb=202712d39046f01f024dc0f637626bc2cd87fd80;hp=26c89cce486982a791e87272cfc1fa634ee8fd7f;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/compiler/coreSyn/PprExternalCore.lhs b/compiler/coreSyn/PprExternalCore.lhs index 26c89cc..1d4e954 100644 --- a/compiler/coreSyn/PprExternalCore.lhs +++ b/compiler/coreSyn/PprExternalCore.lhs @@ -8,6 +8,7 @@ module PprExternalCore () where import Pretty import ExternalCore import Char +import Encoding ( zEncodeString ) instance Show Module where showsPrec d m = shows (pmodule m) @@ -40,7 +41,7 @@ instance Show Lit where indent = nest 2 pmodule (Module mname tdefs vdefgs) = - (text "%module" <+> text mname) + (text "%module" <+> text (zEncodeString mname)) $$ indent ((vcat (map ((<> char ';') . ptdef) tdefs)) $$ (vcat (map ((<> char ';') . pvdefg) vdefgs))) @@ -59,7 +60,7 @@ pcdef (Constr dcon tbinds tys) = pcdef (GadtConstr dcon ty) = (pname dcon) <+> text "::" <+> pty ty -pname id = text id +pname id = text (zEncodeString id) pqname ("",id) = pname id pqname (m,id) = pname m <> char '.' <> pname id @@ -95,12 +96,15 @@ pappty t ts = sep (map paty (t:ts)) pforall tbs (Tforall tb t) = pforall (tbs ++ [tb]) t pforall tbs t = hsep (map ptbind tbs) <+> char '.' <+> pty t -pvdefg (Rec vtes) = text "%rec" $$ braces (indent (vcat (punctuate (char ';') (map pvte vtes)))) -pvdefg (Nonrec vte) = pvte vte +pvdefg (Rec vdefs) = text "%rec" $$ braces (indent (vcat (punctuate (char ';') (map pvdef vdefs)))) +pvdefg (Nonrec vdef) = pvdef vdef -pvte (v,t,e) = sep [pname v <+> text "::" <+> pty t <+> char '=', +pvdef (l,v,t,e) = sep [plocal l <+> pname v <+> text "::" <+> pty t <+> char '=', indent (pexp e)] +plocal True = text "%local" +plocal False = empty + paexp (Var x) = pqname x paexp (Dcon x) = pqname x paexp (Lit l) = plit l