X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=utils%2Fext-core%2FPrinter.hs;h=4e424452c3e099653617bf097f27434367342224;hp=0cd8b09adf84f0c01b41833462f9d7eed6943008;hb=e4417dcd4679da9c6b18c02ff667199c572bed89;hpb=2ad4df602e5bb2cff0315b945fa3201749878c30 diff --git a/utils/ext-core/Printer.hs b/utils/ext-core/Printer.hs index 0cd8b09..4e42445 100644 --- a/utils/ext-core/Printer.hs +++ b/utils/ext-core/Printer.hs @@ -66,14 +66,10 @@ ptdef (Data qtcon tbinds cdefs) = (text "%data" <+> pqname qtcon <+> (hsep (map ptbind tbinds)) <+> char '=') $$ indent (braces ((vcat (punctuate (char ';') (map pcdef cdefs))))) -ptdef (Newtype qtcon tbinds (coercion,cTbs,k) tyopt) = - text "%newtype" <+> pqname qtcon <+> (hsep (map ptbind tbinds)) - $$ indent (axiomclause $$ repclause) - where axiomclause = char '^' <+> parens (pqname coercion <+> - (hsep (map ptbind cTbs)) <+> - text "::" - <+> peqkind k) - repclause = case tyopt of +ptdef (Newtype qtcon coercion tbinds tyopt) = + text "%newtype" <+> pqname qtcon <+> pqname coercion + <+> (hsep (map ptbind tbinds)) $$ indent repclause + where repclause = case tyopt of Just ty -> char '=' <+> pty ty Nothing -> empty @@ -143,6 +139,8 @@ pty (LeftCoercion t) = (pqname leftCoercion <+> paty t) pty (RightCoercion t) = (pqname rightCoercion <+> paty t) +pty (InstCoercion t1 t2) = + (sep [pqname instCoercion, paty t1, paty t2]) pty t = pbty t pappty (Tapp t1 t2) ts = pappty t1 (t2:ts)