X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypes%2FPprType.lhs;h=3d036855c255ca799d2c7f9b97a9a01536ea5d82;hb=1fb1ab5d53a09607e7f6d2450806760688396387;hp=aef320822a43391f6ee420b0551d0dbb38040b74;hpb=8f7ac3fe40d3d55743b824deab655d0797a1c55f;p=ghc-hetmet.git

diff --git a/ghc/compiler/types/PprType.lhs b/ghc/compiler/types/PprType.lhs
index aef3208..3d03685 100644
--- a/ghc/compiler/types/PprType.lhs
+++ b/ghc/compiler/types/PprType.lhs
@@ -31,7 +31,7 @@ IMPORT_DELOOPER(IdLoop)
 -- friends:
 -- (PprType can see all the representations it's trying to print)
 import Type		( GenType(..), maybeAppTyCon,
-			  splitForAllTy, splitSigmaTy, splitRhoTy, splitAppTy )
+			  splitForAllTy, splitSigmaTy, splitRhoTy, splitAppTys )
 import TyVar		( GenTyVar(..) )
 import TyCon		( TyCon(..), NewOrData )
 import Class		( SYN_IE(Class), GenClass(..),
@@ -51,7 +51,7 @@ import PprEnv
 import PprStyle		( PprStyle(..), codeStyle, showUserishTypes )
 import Pretty
 import UniqFM		( addToUFM_Directly, lookupUFM_Directly{-, ufmToList ToDo:rm-} )
-import Unique		( pprUnique10, pprUnique, incrUnique, listTyConKey )
+import Unique	--TEMP:	( pprUnique10, pprUnique, incrUnique, listTyConKey )
 import Util
 \end{code}
 
@@ -177,13 +177,13 @@ ppr_ty env ctxt_prec (FunTy ty1 ty2 usage)
     -- so that right associativity comes out nicely...
   = maybeParen ctxt_prec fUN_PREC
 	(ppCat [ppr_ty env fUN_PREC ty1,
-		ppPStr SLIT("->"),
+		ppStr "->",
 		ppr_ty env tOP_PREC ty2])
 
 ppr_ty env ctxt_prec ty@(AppTy _ _)
   = ppr_corner env ctxt_prec fun_ty arg_tys
   where
-    (fun_ty, arg_tys) = splitAppTy ty
+    (fun_ty, arg_tys) = splitAppTys ty
 
 ppr_ty env ctxt_prec (SynTy tycon tys expansion)
   | codeStyle (pStyle env)
@@ -275,7 +275,7 @@ pprGenTyVar sty (TyVar uniq kind name usage)
   = case sty of
       PprInterface -> pp_u
       _		   -> ppBesides [pp_name, ppStr "{-", pp_u, ppStr "-}"]
-  where
+   where
     pp_u    = pprUnique uniq
     pp_name = case name of
 		Just n  -> pprOccName sty (getOccName n)
@@ -291,7 +291,8 @@ We print type-variable binders with their kinds in interface files.
 \begin{code}
 pprTyVarBndr sty@PprInterface tyvar@(TyVar uniq kind name usage)
   | not (isBoxedTypeKind kind)
-  = ppBesides [pprGenTyVar sty tyvar, ppStr "::", pprParendKind kind]
+  = ppBesides [pprGenTyVar sty tyvar, ppStr " :: ", pprParendKind kind]
+	-- See comments with ppDcolon in PprCore.lhs
 
 pprTyVarBndr sty tyvar = pprGenTyVar sty tyvar
 \end{code}
@@ -355,11 +356,11 @@ pprTyCon sty (SpecTyCon tc ty_maybes)
 pprTyCon sty (SynTyCon uniq name kind arity tyvars expansion)
   = ppBeside (ppr sty name)
 	     (ifPprShowAll sty
-		(ppCat [ ppStr " {-", 
+		(ppCat [ ppPStr SLIT(" {-"), 
 			 ppInt arity, 
 			 interpp'SP sty tyvars,
 			 pprParendGenType sty expansion,
-			 ppStr "-}"]))
+			 ppPStr SLIT("-}")]))
 -}
 \end{code}
 
@@ -404,7 +405,7 @@ ppr_class_op sty tyvars (ClassOp op_name i ty)
 getTypeString :: Type -> FAST_STRING
 
 getTypeString ty
-  = case (splitAppTy ty) of { (tc, args) ->
+  = case (splitAppTys ty) of { (tc, args) ->
     _CONCAT_ (do_tc tc : map do_arg_ty args) }
   where
     do_tc (TyConTy tc _) = nameString (getName tc)
@@ -536,7 +537,7 @@ nmbrTyVar tv@(TyVar u _ _ _) nenv@(NmbrEnv ui ut uu idenv tvenv uvenv)
   = case (lookupUFM_Directly tvenv u) of
       Just xx -> (nenv, xx)
       Nothing ->
-	--pprTrace "nmbrTyVar: lookup failed:" (ppCat (ppr PprDebug u : [ppCat [ppr PprDebug x, ppStr "=>", ppr PprDebug tv] | (x,tv) <- ufmToList tvenv])) $
+	--pprTrace "nmbrTyVar: lookup failed:" (ppCat (ppr PprDebug u : [ppCat [ppr PprDebug x, ppPStr SLIT("=>"), ppr PprDebug tv] | (x,tv) <- ufmToList tvenv])) $
 	(nenv, tv)
 \end{code}