External Core lib: lots of cleanup

[ghc-hetmet.git] / utils / ext-core / Language / Core / Printer.hs

diff --git a/utils/ext-core/Language/Core/Printer.hs b/utils/ext-core/Language/Core/Printer.hs
index 0a3e2cf..d7c4cdb 100644 (file)
--- a/utils/ext-core/Language/Core/Printer.hs
+++ b/utils/ext-core/Language/Core/Printer.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -Werror -Wall -fno-warn-missing-signatures #-}
+{-# OPTIONS -Wall -fno-warn-missing-signatures #-}
 
 module Language.Core.Printer where
 
@@ -7,7 +7,6 @@ import Data.Char
 
 import Language.Core.Core
 import Language.Core.Encoding
-import Language.Core.PrimCoercions
 
 instance Show Module where
   showsPrec _ m = shows (pmodule m)
@@ -36,6 +35,11 @@ instance Show Ty where
 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)
 
@@ -128,17 +132,17 @@ 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 ([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)