[project @ 2005-07-25 11:11:36 by simonpj]

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

diff --git a/ghc/compiler/types/TypeRep.lhs b/ghc/compiler/types/TypeRep.lhs
index 5c4bd33..f5bb325 100644 (file)
--- a/ghc/compiler/types/TypeRep.lhs
+++ b/ghc/compiler/types/TypeRep.lhs
@@ -33,9 +33,9 @@ import Kind
 import Var       ( Var, Id, TyVar, tyVarKind )
 import VarSet     ( TyVarSet )
 import Name      ( Name, NamedThing(..), BuiltInSyntax(..), mkWiredInName )
-import OccName   ( mkOccFS, tcName )
+import OccName   ( mkOccFS, tcName, parenSymOcc )
 import BasicTypes ( IPName, tupleParens )
-import TyCon     ( TyCon, mkFunTyCon, tyConArity, tupleTyConBoxity, isTupleTyCon, isRecursiveTyCon )
+import TyCon     ( TyCon, mkFunTyCon, tyConArity, tupleTyConBoxity, isTupleTyCon, isRecursiveTyCon, isNewTyCon )
 import Class     ( Class )
 
 -- others
@@ -114,7 +114,7 @@ Similarly splitForAllTys and splitFunTys can get into a loop.
 
 Solution: 
 
-* Newtypes are always represented using NewTcApp, never as TyConApp.
+* Newtypes are always represented using TyConApp.
 
 * For non-recursive newtypes, P, treat P just like a type synonym after 
   type-checking is done; i.e. it's opaque during type checking (functions
@@ -148,26 +148,16 @@ data Type
   = TyVarTy TyVar      
 
   | AppTy
-       Type            -- Function is *not* a TyConApp or NewTcApp
+       Type            -- Function is *not* a TyConApp
        Type            -- It must be another AppTy, or TyVarTy
                        -- (or NoteTy of these)
 
-  | TyConApp           -- Application of a TyCon
-       TyCon           -- *Invariant* saturated appliations of FunTyCon and
+  | TyConApp           -- Application of a TyCon, including newtypes
+       TyCon           --  *Invariant* saturated appliations of FunTyCon and
                        --      synonyms have their own constructors, below.
-       [Type]          -- Might not be saturated.
-
-  | NewTcApp           -- Application of a NewType TyCon.   All newtype applications
-       TyCon           -- show up like this until they are fed through newTypeRep,
-                       -- which returns 
-                       --      * an ordinary TyConApp for non-saturated, 
-                       --       or recursive newtypes
-                       --
-                       --      * the representation type of the newtype for satuarted, 
-                       --        non-recursive ones
-                       -- [But the result of a call to newTypeRep is always consumed
-                       --  immediately; it never lives on in another type.  So in any
-                       --  type, newtypes are always represented with NewTcApp.]
+                       -- However, *unsaturated* type synonyms, and FunTyCons
+                       --      do appear as TyConApps.  (Unsaturated type synonyms
+                       --      can appear as the RHS of a type synonym, for exmaple.)
        [Type]          -- Might not be saturated.
 
   | FunTy              -- Special case of TyConApp: TyConApp FunTyCon [t1,t2]
@@ -327,7 +317,8 @@ pprPred (ClassP cls tys) = pprClassPred cls tys
 pprPred (IParam ip ty)   = ppr ip <> dcolon <> pprType ty
 
 pprClassPred :: Class -> [Type] -> SDoc
-pprClassPred clas tys = ppr clas <+> sep (map pprParendType tys)
+pprClassPred clas tys = parenSymOcc (getOccName clas) (ppr clas) 
+                       <+> sep (map pprParendType tys)
 
 pprTheta :: ThetaType -> SDoc
 pprTheta theta = parens (sep (punctuate comma (map pprPred theta)))
@@ -357,15 +348,13 @@ ppr_type p (NoteTy (SynNote ty1) ty2) = ppr_type p ty1
 ppr_type p (NoteTy other         ty2) = ppr_type p ty2
 
 ppr_type p (TyConApp tc tys) = ppr_tc_app p tc tys
-ppr_type p (NewTcApp tc tys) = ifPprDebug (if isRecursiveTyCon tc 
-                                          then ptext SLIT("<recnt>")
-                                          else ptext SLIT("<nt>")
-                                 ) <> 
-                              ppr_tc_app p tc tys
 
 ppr_type p (AppTy t1 t2) = maybeParen p TyConPrec $
                           pprType t1 <+> ppr_type TyConPrec t2
 
+ppr_type p ty@(ForAllTy _ _)       = ppr_forall_type p ty
+ppr_type p ty@(FunTy (PredTy _) _) = ppr_forall_type p ty
+
 ppr_type p (FunTy ty1 ty2)
   = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
     maybeParen p FunPrec $
@@ -374,7 +363,8 @@ ppr_type p (FunTy ty1 ty2)
     ppr_fun_tail (FunTy ty1 ty2) = (arrow <+> ppr_type FunPrec ty1) : ppr_fun_tail ty2
     ppr_fun_tail other_ty        = [arrow <+> pprType other_ty]
 
-ppr_type p ty@(ForAllTy _ _)  
+ppr_forall_type :: Prec -> Type -> SDoc
+ppr_forall_type p ty
   = maybeParen p FunPrec $
     sep [pprForAll tvs, pprThetaArrow ctxt, pprType tau]
   where
@@ -393,7 +383,7 @@ ppr_type p ty@(ForAllTy _ _)
 
 ppr_tc_app :: Prec -> TyCon -> [Type] -> SDoc
 ppr_tc_app p tc [] 
-  = ppr tc
+  = ppr_tc tc
 ppr_tc_app p tc [ty] 
   | tc `hasKey` listTyConKey = brackets (pprType ty)
   | tc `hasKey` parrTyConKey = ptext SLIT("[:") <> pprType ty <> ptext SLIT(":]")
@@ -402,9 +392,18 @@ ppr_tc_app p tc tys
   = tupleParens (tupleTyConBoxity tc) (sep (punctuate comma (map pprType tys)))
   | otherwise
   = maybeParen p TyConPrec $
-    ppr tc <+> sep (map (ppr_type TyConPrec) tys)
+    ppr_tc tc <+> sep (map (ppr_type TyConPrec) tys)
+
+ppr_tc :: TyCon -> SDoc
+ppr_tc tc = parenSymOcc (getOccName tc) (pp_nt_debug <> ppr tc)
+  where
+   pp_nt_debug | isNewTyCon tc = ifPprDebug (if isRecursiveTyCon tc 
+                                            then ptext SLIT("<recnt>")
+                                            else ptext SLIT("<nt>"))
+              | otherwise     = empty
 
 -------------------
+pprForAll []  = empty
 pprForAll tvs = ptext SLIT("forall") <+> sep (map pprTvBndr tvs) <> dot
 
 pprTvBndr tv | isLiftedTypeKind kind = ppr tv