\begin{code}
module PprExternalCore () where
-import ExternalCore
import Encoding
+import ExternalCore
import Pretty
import Char
-
instance Show Module where
showsPrec _ m = shows (pmodule m)
(text "%data" <+> pqname tcon <+> (hsep (map ptbind tbinds)) <+> char '=')
$$ indent (braces ((vcat (punctuate (char ';') (map pcdef cdefs)))))
-ptdef (Newtype tcon tbinds (coercion,tbs,k) rep) =
--- Here we take apart the newtype tycon in order to get the newtype coercion,
--- which needs to be represented in the External Core file because it's not
--- straightforward to derive its definition from the newtype declaration alone.
--- At the same time, we need the newtype decl to declare the tycon itself.
--- Sigh.
- text "%newtype" <+> pqname tcon <+> (hsep (map ptbind tbinds))
- $$ indent (axiomclause $$ repclause)
- where axiomclause = char '^'
- <+> parens (pqname coercion <+> (hsep (map ptbind tbs))
- <+> text "::"
- <+> pkind k)
- repclause = case rep of
- Just ty -> char '=' <+> pty ty
- Nothing -> empty
-
+ptdef (Newtype tcon coercion tbinds rep) =
+ text "%newtype" <+> pqname tcon <+> pqname coercion
+ <+> (hsep (map ptbind tbinds)) $$ indent repclause
+ where repclause = char '=' <+> pty rep
pcdef :: Cdef -> Doc
pcdef (Constr dcon tbinds tys) =
paty t = parens (pty t)
pbty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = parens(fsep [pbty t1, text "->",pty t2])
-pbty (Tapp t1 t2) = pappty t1 [t2]
+pbty (Tapp t1 t2) = parens $ pappty t1 [t2]
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