[project @ 1997-05-18 22:26:40 by sof]

New PP

diff --git a/ghc/compiler/typecheck/TcInstUtil.lhs b/ghc/compiler/typecheck/TcInstUtil.lhs
index e4dd21f..3246e0a 100644 (file)
--- a/ghc/compiler/typecheck/TcInstUtil.lhs
+++ b/ghc/compiler/typecheck/TcInstUtil.lhs
@@ -24,13 +24,13 @@ import TcEnv                ( tcAddImportedIdInfo )
 import TcMonad
 import Inst            ( SYN_IE(InstanceMapper) )
 
-import Bag             ( bagToList )
+import Bag             ( bagToList, Bag )
 import Class           ( GenClass, GenClassOp, SYN_IE(ClassInstEnv),
                          classBigSig, classOps, classOpLocalType,
-                         SYN_IE(ClassOp)
+                         SYN_IE(ClassOp), SYN_IE(Class)
                        )
 import CoreSyn         ( GenCoreExpr(..), mkValLam, mkTyApp )
-import Id              ( GenId, mkDictFunId, mkConstMethodId, mkSysLocal )
+import Id              ( GenId, mkDictFunId, mkConstMethodId, mkSysLocal, SYN_IE(Id) )
 import MatchEnv                ( nullMEnv, insertMEnv )
 import Maybes          ( MaybeErr(..), mkLookupFunDef )
 import Name            ( getSrcLoc, Name{--O only-} )
@@ -39,10 +39,16 @@ import Pretty
 import SpecEnv         ( SpecEnv, nullSpecEnv, addOneToSpecEnv )
 import SrcLoc          ( SrcLoc )
 import Type            ( mkSigmaTy, mkForAllTys, mkDictTy, mkTyVarTys,
-                         splitForAllTy, instantiateTy, matchTy, SYN_IE(ThetaType) )
-import TyVar           ( GenTyVar )
+                         instantiateTy, matchTy, SYN_IE(ThetaType),
+                         SYN_IE(Type) )
+import TyVar           ( GenTyVar, SYN_IE(TyVar) )
 import Unique          ( Unique )
-import Util            ( equivClasses, zipWithEqual, panic{-, pprTrace-} )
+import Util            ( equivClasses, zipWithEqual, panic{-, pprTrace-}, Ord3(..) )
+
+#if __GLASGOW_HASKELL__ >= 202
+import Outputable
+#endif
+
 --import PprStyle
 
 --import TcPragmas     ( tcDictFunPragmas, tcGenPragmas )
@@ -229,10 +235,10 @@ addClassInstance
 dupInstFailure clas info1@(ty1, locn1) info2@(ty2, locn2)
        -- Overlapping/duplicate instances for given class; msg could be more glamourous
   = tcAddErrCtxt ctxt $
-    failTc (\sty -> ppPStr SLIT("Duplicate or overlapping instance declarations"))
+    failTc (\sty -> ptext SLIT("Duplicate or overlapping instance declarations"))
   where
-    ctxt sty = ppHang (ppSep [ppBesides[ppPStr SLIT("Class `"), ppr sty clas, ppChar '\''],
-                             ppBesides[ppPStr SLIT("type `"), ppr sty ty1, ppChar '\'']])
-                   4 (ppSep [ppBesides [ppPStr SLIT("at "), ppr sty locn1],
-                             ppBesides [ppPStr SLIT("and "), ppr sty locn2]])
+    ctxt sty = hang (sep [ptext SLIT("Class"), ppr sty clas,
+                         ptext SLIT("type"),  ppr sty ty1])
+                   4 (sep [hcat [ptext SLIT("at "), ppr sty locn1],
+                             hcat [ptext SLIT("and "), ppr sty locn2]])
 \end{code}

diff --git a/ghc/compiler/typecheck/TcKind.lhs b/ghc/compiler/typecheck/TcKind.lhs
index 8dd9e5b..20b0ff1 100644 (file)
--- a/ghc/compiler/typecheck/TcKind.lhs
+++ b/ghc/compiler/typecheck/TcKind.lhs
@@ -24,6 +24,9 @@ import TcMonad
 import Unique  ( Unique, pprUnique10 )
 import Pretty
 import Util    ( nOfThem )
+#if __GLASGOW_HASKELL__ >= 202
+import Outputable
+#endif
 \end{code}
 
 
@@ -179,13 +182,13 @@ instance Outputable (TcKind s) where
   ppr sty kind = ppr_kind sty kind
 
 ppr_kind sty TcTypeKind 
-  = ppChar '*'
+  = char '*'
 ppr_kind sty (TcArrowKind kind1 kind2) 
-  = ppSep [ppr_parend sty kind1, ppPStr SLIT("->"), ppr_kind sty kind2]
+  = sep [ppr_parend sty kind1, ptext SLIT("->"), ppr_kind sty kind2]
 ppr_kind sty (TcVarKind uniq box) 
-  = ppBesides [ppChar 'k', pprUnique10 uniq]
+  = hcat [char 'k', pprUnique10 uniq]
 
-ppr_parend sty kind@(TcArrowKind _ _) = ppBesides [ppChar '(', ppr_kind sty kind, ppChar ')']
+ppr_parend sty kind@(TcArrowKind _ _) = hcat [char '(', ppr_kind sty kind, char ')']
 ppr_parend sty other_kind            = ppr_kind sty other_kind
 \end{code}
 
@@ -195,20 +198,17 @@ Errors and contexts
 ~~~~~~~~~~~~~~~~~~~
 \begin{code}
 unifyKindCtxt kind1 kind2 sty
-  = ppHang (ppPStr SLIT("When unifying two kinds")) 4
-          (ppSep [ppr sty kind1, ppPStr SLIT("and"), ppr sty kind2])
+  = hang (ptext SLIT("When unifying two kinds")) 4
+          (sep [ppr sty kind1, ptext SLIT("and"), ppr sty kind2])
 
 kindOccurCheck kind1 kind2 sty
-  = ppHang (ppPStr SLIT("Cannot construct the infinite kind:")) 4
-       (ppSep [ppBesides [ppChar '`', ppr sty kind1, ppChar '\''],
-               ppChar '=',
-               ppBesides [ppChar '`', ppr sty kind1, ppChar '\''],
-               ppPStr SLIT("(\"occurs check\")")])
+  = hang (ptext SLIT("Cannot construct the infinite kind:")) 4
+       (sep [ppr sty kind1, equals, ppr sty kind1, ptext SLIT("(\"occurs check\")")])
 
 kindMisMatchErr kind1 kind2 sty
- = ppHang (ppPStr SLIT("Couldn't match the kind")) 4
-       (ppSep [ppBesides [ppChar '`', ppr sty kind1, ppChar '\''],
-               ppPStr SLIT("against"),
-               ppBesides [ppChar '`', ppr sty kind2, ppChar '\'']
-       ])
+ = hang (ptext SLIT("Couldn't match the kind")) 4
+       (sep [ppr sty kind1,
+             ptext SLIT("against"),
+             ppr sty kind2]
+       )
 \end{code}

diff --git a/ghc/compiler/typecheck/TcMatches.lhs b/ghc/compiler/typecheck/TcMatches.lhs
index 143f0b4..38a5d16 100644 (file)
--- a/ghc/compiler/typecheck/TcMatches.lhs
+++ b/ghc/compiler/typecheck/TcMatches.lhs
@@ -11,7 +11,7 @@ module TcMatches ( tcMatchesFun, tcMatchesCase, tcMatch ) where
 IMP_Ubiq()
 
 import HsSyn           ( Match(..), GRHSsAndBinds(..), GRHS(..), InPat,
-                         HsExpr, HsBinds, OutPat, Fake,
+                         HsExpr, HsBinds, OutPat, Fake, Stmt,
                          collectPatBinders, pprMatch )
 import RnHsSyn         ( SYN_IE(RenamedMatch) )
 import TcHsSyn         ( TcIdOcc(..), SYN_IE(TcMatch) )
@@ -29,6 +29,11 @@ import Kind          ( Kind, mkTypeKind )
 import Pretty
 import Type            ( isTyVarTy, mkFunTy, getFunTy_maybe )
 import Util
+import Outputable
+#if __GLASGOW_HASKELL__ >= 202
+import SrcLoc           (SrcLoc)
+#endif
+
 \end{code}
 
 @tcMatchesFun@ typechecks a @[Match]@ list which occurs in a
@@ -208,16 +213,16 @@ Errors and contexts
 ~~~~~~~~~~~~~~~~~~~
 \begin{code}
 matchCtxt MCase match sty
-  = ppHang (ppPStr SLIT("In a \"case\" branch:"))
+  = hang (ptext SLIT("In a \"case\" branch:"))
         4 (pprMatch sty True{-is_case-} match)
 
 matchCtxt (MFun fun) match sty
-  = ppHang (ppBesides [ppPStr SLIT("In an equation for function "), ppr sty fun, ppChar ':'])
-        4 (ppBesides [ppr sty fun, ppSP, pprMatch sty False{-not case-} match])
+  = hang (hcat [ptext SLIT("In an equation for function "), ppr sty fun, char ':'])
+        4 (pprQuote sty $ \sty -> hcat [ppr sty fun, space, pprMatch sty False{-not case-} match])
 \end{code}
 
 
 \begin{code}
 varyingArgsErr name matches sty
-  = ppSep [ppPStr SLIT("Varying number of arguments for function"), ppr sty name]
+  = sep [ptext SLIT("Varying number of arguments for function"), ppr sty name]
 \end{code}