From f515d87a510f9cd3d416d83e95e6e0f0298f7d18 Mon Sep 17 00:00:00 2001
From: Manuel M T Chakravarty <chak@cse.unsw.edu.au>
Date: Thu, 19 Oct 2006 16:58:40 +0000
Subject: [PATCH] Fix show-iface for family instances & add debug ppr for type
 declarations

---
 compiler/iface/LoadIface.lhs      |    1 +
 compiler/typecheck/TcRnDriver.lhs |   24 +++++++++++++++++++++++-
 2 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index 0d9feb4..9c89f18 100644
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -555,6 +555,7 @@ pprModIface iface
 	, pprFixities (mi_fixities iface)
 	, vcat (map pprIfaceDecl (mi_decls iface))
 	, vcat (map ppr (mi_insts iface))
+	, vcat (map ppr (mi_fam_insts iface))
 	, vcat (map ppr (mi_rules iface))
 	, pprDeprecs (mi_deprecs iface)
 	]
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 696e41b..80f2da2 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -461,7 +461,7 @@ tcRnHsBootDecls decls
 	; gbl_env <- getGblEnv 
 	
 		-- Make the final type-env
-		-- Include the dfun_ids so that their type sigs get
+		-- Include the dfun_ids so that their type sigs
 		-- are written into the interface file
 	; let { type_env0 = tcg_type_env gbl_env
 	      ; type_env1 = extendTypeEnvWithIds type_env0 val_ids
@@ -1276,6 +1276,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
 		        tcg_rules     = rules,
 			tcg_imports   = imports })
   = vcat [ ppr_types insts type_env
+	 , ppr_tycons fam_insts type_env
 	 , ppr_insts insts
 	 , ppr_fam_insts fam_insts
 	 , vcat (map ppr rules)
@@ -1304,6 +1305,17 @@ ppr_types insts type_env
 	-- that the type checker has invented.  Top-level user-defined things 
 	-- have External names.
 
+ppr_tycons :: [FamInst] -> TypeEnv -> SDoc
+ppr_tycons fam_insts type_env
+  = text "TYPE CONSTRUCTORS" $$ nest 4 (ppr_tydecls tycons)
+  where
+    fi_tycons = map famInstTyCon fam_insts
+    tycons = [tycon | tycon <- typeEnvTyCons type_env, want_tycon tycon]
+    want_tycon tycon | opt_PprStyle_Debug = True
+	             | otherwise	  = not (isImplicitTyCon tycon) &&
+					    isExternalName (tyConName tycon) &&
+				            not (tycon `elem` fi_tycons)
+
 ppr_insts :: [Instance] -> SDoc
 ppr_insts []     = empty
 ppr_insts ispecs = text "INSTANCES" $$ nest 2 (pprInstances ispecs)
@@ -1321,6 +1333,16 @@ ppr_sigs ids
     le_sig id1 id2 = getOccName id1 <= getOccName id2
     ppr_sig id = ppr id <+> dcolon <+> ppr (tidyTopType (idType id))
 
+ppr_tydecls :: [TyCon] -> SDoc
+ppr_tydecls tycons
+	-- Print type constructor info; sort by OccName 
+  = vcat (map ppr_tycon (sortLe le_sig tycons))
+  where
+    le_sig tycon1 tycon2 = getOccName tycon1 <= getOccName tycon2
+    ppr_tycon tycon 
+      | isCoercionTyCon tycon = ptext SLIT("coercion") <+> ppr tycon
+      | otherwise             = ppr (tyThingToIfaceDecl (ATyCon tycon))
+
 ppr_rules :: [CoreRule] -> SDoc
 ppr_rules [] = empty
 ppr_rules rs = vcat [ptext SLIT("{-# RULES"),
-- 
1.7.10.4