X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsTypes.lhs;h=f4146a482fcf5e69b5c3719280f7da0b52b536e3;hb=74f9d560161bacefe72cb1f2bea979291cb7af3d;hp=a795a2f1ae1ad91e88285e2de91f56cd076563e3;hpb=495ef8bd9ef30bffe50ea399b91e3ba09646b59a;p=ghc-hetmet.git

diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs
index a795a2f..f4146a4 100644
--- a/ghc/compiler/hsSyn/HsTypes.lhs
+++ b/ghc/compiler/hsSyn/HsTypes.lhs
@@ -27,9 +27,7 @@ module HsTypes (
 
 import Class		( FunDep )
 import Type		( Type, Kind, PredType(..), UsageAnn(..), ClassContext,
-			  getTyVar_maybe, splitFunTy_maybe, splitAppTy_maybe,
-			  splitTyConApp_maybe, splitPredTy_maybe,
-			  splitUsgTy, splitSigmaTy, unUsgTy, boxedTypeKind
+			  getTyVar_maybe, splitSigmaTy, unUsgTy, boxedTypeKind
 			)
 import TypeRep		( Type(..), TyNote(..) )	-- toHsType sees the representation
 import TyCon		( isTupleTyCon, tupleTyConBoxity, tyConArity, tyConClass_maybe )
@@ -145,6 +143,9 @@ replaceTyVarName (IfaceTyVar n k) n' = IfaceTyVar n' k
 %*									*
 %************************************************************************
 
+NB: these types get printed into interface files, so 
+    don't change the printing format lightly
+
 \begin{code}
 instance (Outputable name) => Outputable (HsType name) where
     ppr ty = pprHsType ty
@@ -162,7 +163,21 @@ pprHsTyVarBndr name kind | kind == boxedTypeKind = ppr name
 			 | otherwise 	         = hsep [ppr name, dcolon, pprParendKind kind]
 
 pprHsForAll []  []  = empty
-pprHsForAll tvs cxt = ptext SLIT("__forall") <+> interppSP tvs <+> ppr_context cxt <+> ptext SLIT("=>")
+pprHsForAll tvs cxt 
+	-- This printer is used for both interface files and
+	-- printing user types in error messages; and alas the
+	-- two use slightly different syntax.  Ah well.
+  = getPprStyle $ \ sty ->
+    if userStyle sty then
+	ptext SLIT("forall") <+> interppSP tvs <> dot <+> 
+	(if null cxt then 
+		empty 
+	 else 
+		ppr_context cxt <+> ptext SLIT("=>")
+	)
+    else	-- Used in interfaces
+	ptext SLIT("__forall") <+> interppSP tvs <+> 
+	ppr_context cxt <+> ptext SLIT("=>")
 
 pprHsContext :: (Outputable name) => HsContext name -> SDoc
 pprHsContext []	 = empty