[project @ 2000-06-27 16:36:00 by lewie]

[ghc-hetmet.git] / ghc / compiler / hsSyn / HsTypes.lhs

diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs
index a795a2f..f4146a4 100644 (file)
--- 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