[project @ 2002-01-25 10:28:12 by simonmar]

[ghc-hetmet.git] / ghc / compiler / types / PprType.lhs

diff --git a/ghc/compiler/types/PprType.lhs b/ghc/compiler/types/PprType.lhs
index f191fda..dab39da 100644 (file)
--- a/ghc/compiler/types/PprType.lhs
+++ b/ghc/compiler/types/PprType.lhs
@@ -18,9 +18,10 @@ module PprType(
 
 -- friends:
 -- (PprType can see all the representations it's trying to print)
-import TypeRep         ( Type(..), TyNote(..), Kind, liftedTypeKind ) -- friend
+import TypeRep         ( Type(..), TyNote(..), 
+                         Kind, liftedTypeKind ) -- friend
 import Type            ( SourceType(..), isUTyVar, eqKind )
-import TcType          ( ThetaType, PredType, 
+import TcType          ( ThetaType, PredType,
                          tcSplitSigmaTy, isPredTy, isDictTy,
                          tcSplitTyConApp_maybe, tcSplitFunTy_maybe
                        ) 
@@ -35,9 +36,11 @@ import TyCon         ( TyCon, isPrimTyCon, isTupleTyCon, tupleTyConBoxity,
 import CmdLineOpts     ( opt_PprStyle_RawTypes )
 import Maybes          ( maybeToBool )
 import Name            ( getOccString, getOccName )
+import OccName         ( occNameUserString )
 import Outputable
 import Unique          ( Uniquable(..) )
-import BasicTypes      ( tupleParens )
+import Util             ( lengthIs )
+import BasicTypes      ( IPName(..), tupleParens, ipNameName )
 import PrelNames               -- quite a few *Keys
 \end{code}
 
@@ -66,8 +69,7 @@ pprPred = pprSourceType
 
 pprSourceType :: SourceType -> SDoc
 pprSourceType (ClassP clas tys) = pprClassPred clas tys
-pprSourceType (IParam n ty)     = hsep [ptext SLIT("?") <> ppr n,
-                                 ptext SLIT("::"), ppr ty]
+pprSourceType (IParam n ty)     = hsep [ppr n, dcolon, ppr ty]
 pprSourceType (NType tc tys)    = ppr tc <+> hsep (map pprParendType tys)
 
 pprClassPred :: Class -> [Type] -> SDoc
@@ -79,8 +81,12 @@ pprTheta theta = parens (hsep (punctuate comma (map pprPred theta)))
 instance Outputable Type where
     ppr ty = pprType ty
 
-instance Outputable PredType where
+instance Outputable SourceType where
     ppr = pprPred
+
+instance Outputable name => Outputable (IPName name) where
+    ppr (Dupable n) = char '?' <> ppr n -- Ordinary implicit parameters
+    ppr (Linear  n) = char '%' <> ppr n -- Splittable implicit parameters
 \end{code}
 
 
@@ -136,7 +142,7 @@ ppr_ty ctxt_prec ty@(TyConApp tycon tys)
        
        -- TUPLE CASE (boxed and unboxed)
   |  isTupleTyCon tycon,
-     length tys == tyConArity tycon    -- No magic if partially applied
+      tys `lengthIs` tyConArity tycon  -- No magic if partially applied
   = tupleParens (tupleTyConBoxity tycon)
                (sep (punctuate comma (map (ppr_ty tOP_PREC) tys)))
 
@@ -249,7 +255,7 @@ getTyDescription ty
       TyVarTy _                     -> "*"
       AppTy fun _                   -> getTyDescription fun
       FunTy _ res                   -> '-' : '>' : fun_result res
-      TyConApp tycon _              -> getOccString tycon
+      TyConApp tycon _              -> occNameUserString (getOccName tycon)
       NoteTy (FTVNote _) ty  -> getTyDescription ty
       NoteTy (SynNote ty1) _ -> getTyDescription ty1
       SourceTy sty          -> getSourceTyDescription sty
@@ -261,7 +267,7 @@ getTyDescription ty
 
 getSourceTyDescription (ClassP cl tys) = getOccString cl
 getSourceTyDescription (NType  tc tys) = getOccString tc
-getSourceTyDescription (IParam id ty)  = getOccString id
+getSourceTyDescription (IParam ip ty)  = getOccString (ipNameName ip)
 \end{code}