From 6267d836c50aedd5a8c4823732da2948285682d2 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 19 Dec 1996 09:39:51 +0000
Subject: [PATCH] [project @ 1996-12-19 09:39:49 by simonpj] Tiny bug fix to
 printing of interfaces

---
 ghc/compiler/basicTypes/Name.lhs |    3 ++-
 ghc/compiler/hsSyn/HsTypes.lhs   |   12 +++++++++---
 2 files changed, 11 insertions(+), 4 deletions(-)

diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index d4b56e0..824d7a5 100644
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -401,7 +401,8 @@ instance NamedThing Name where
 instance Outputable Name where
     ppr sty (Local u n _) | codeStyle sty ||
 			    ifaceStyle sty = pprUnique u
-			  | otherwise      = ppBesides [ppPStr (occNameString n), ppPStr SLIT("_"), pprUnique u]
+    ppr PprForUser (Local _ n _) = ppPStr (occNameString n)
+    ppr other_sty  (Local u n _) = ppBesides [ppPStr (occNameString n), ppPStr SLIT("_"), pprUnique u]
 
     ppr sty (Global u m n _ _) = ppBesides [pp_name, pp_uniq sty u]
 			       where
diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs
index e558d4d..d94e1a2 100644
--- a/ghc/compiler/hsSyn/HsTypes.lhs
+++ b/ghc/compiler/hsSyn/HsTypes.lhs
@@ -25,7 +25,9 @@ IMP_Ubiq()
 
 import Outputable	( interppSP, ifnotPprForUser )
 import Kind		( Kind {- instance Outputable -} )
+import Name		( nameOccName )
 import Pretty
+import PprStyle		( PprStyle(..) )
 import Util		( thenCmp, cmpList, isIn, panic# )
 \end{code}
 
@@ -104,10 +106,14 @@ instance (Outputable name) => Outputable (HsType name) where
     ppr = pprHsType
 
 instance (Outputable name) => Outputable (HsTyVar name) where
-    ppr sty (UserTyVar name) = ppr sty name
-    ppr sty (IfaceTyVar name kind) = ppCat [ppr sty name, ppStr "::", ppr sty kind]
+    ppr sty (UserTyVar name) = ppr_hs_tyvar sty name
+    ppr sty (IfaceTyVar name kind) = ppCat [ppr_hs_tyvar sty name, ppStr "::", ppr sty kind]
 
 
+-- Here
+ppr_hs_tyvar PprInterface tv_name = ppr PprForUser tv_name
+ppr_hs_tyvar other_sty    tv_name = ppr other_sty tv_name
+
 ppr_forall sty ctxt_prec [] [] ty
    = ppr_mono_ty sty ctxt_prec ty
 ppr_forall sty ctxt_prec tvs ctxt ty
@@ -142,7 +148,7 @@ pprParendHsType sty ty = ppr_mono_ty sty pREC_CON ty
 ppr_mono_ty sty ctxt_prec (HsPreForAllTy ctxt ty)     = ppr_forall sty ctxt_prec [] ctxt ty
 ppr_mono_ty sty ctxt_prec (HsForAllTy tvs ctxt ty)    = ppr_forall sty ctxt_prec tvs ctxt ty
 
-ppr_mono_ty sty ctxt_prec (MonoTyVar name) = ppr sty name
+ppr_mono_ty sty ctxt_prec (MonoTyVar name) = ppr_hs_tyvar sty name
 
 ppr_mono_ty sty ctxt_prec (MonoFunTy ty1 ty2)
   = let p1 = ppr_mono_ty sty pREC_FUN ty1
-- 
1.7.10.4