-{-# OPTIONS -Werror -Wall -fno-warn-missing-signatures #-}
+{-# OPTIONS -Wall -fno-warn-missing-signatures #-}
module Language.Core.Printer where
import Language.Core.Core
import Language.Core.Encoding
-import Language.Core.PrimCoercions
instance Show Module where
showsPrec _ m = shows (pmodule m)
instance Show Kind where
showsPrec _ k = shows (pkind k)
+instance Show CoercionKind where
+ showsPrec _ (DefinedCoercion tbs (from,to)) =
+ shows $ parens (text "defined coercion:" <+> (hsep (map ptbind tbs))
+ <+> text ":" <+> brackets (pty from)
+ <+> text "->" <+> brackets (pty to))
instance Show Lit where
showsPrec _ l = shows (plit l)
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 ([pqname transCoercion, paty t1, paty t2]))
+ (sep ([text "%trans", paty t1, paty t2]))
pty (SymCoercion t) =
- (sep [pqname symCoercion, paty t])
+ (sep [text "%sym", paty t])
pty (UnsafeCoercion t1 t2) =
- (sep [pqname unsafeCoercion, paty t1, paty t2])
+ (sep [text "%unsafe", paty t1, paty t2])
pty (LeftCoercion t) =
- (pqname leftCoercion <+> paty t)
+ (text "%left" <+> paty t)
pty (RightCoercion t) =
- (pqname rightCoercion <+> paty t)
+ (text "%right" <+> paty t)
pty (InstCoercion t1 t2) =
- (sep [pqname instCoercion, paty t1, paty t2])
+ (sep [text "%inst", paty t1, paty t2])
pty t = pbty t
pappty (Tapp t1 t2) ts = pappty t1 (t2:ts)