X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypes%2FTypeRep.lhs;h=db41403a4b46b009779dbc5e342d579b63e19cfb;hp=87ffacd22670c0c9024cd15499d37de29247f390;hb=c0687066474aa4ce4912f31a5c09c1bcd673fb06;hpb=224ef3094189bc9a33f23285b5dccbffdd8d7de0

diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index 87ffacd..db41403 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -145,11 +145,12 @@ data Type
 	                --    can appear as the right hand side of a type synonym.
 
   | FunTy
-	Type
+	Type		
 	Type		-- ^ Special case of 'TyConApp': @TyConApp FunTyCon [t1, t2]@
+			-- See Note [Equality-constrained types]
 
   | ForAllTy
-	TyCoVar         -- ^ Type *or* coercion variable; see Note [Equality-constrained types]
+	TyCoVar         -- Type variable
 	Type	        -- ^ A polymorphic type
 
   | PredTy
@@ -183,21 +184,9 @@ The type   forall ab. (a ~ [b]) => blah
 is encoded like this:
 
    ForAllTy (a:*) $ ForAllTy (b:*) $
-   ForAllTy (wild_co : a ~ [b]) $
+   FunTy (PredTy (EqPred a [b]) $
    blah
 
-That is, the "(a ~ [b]) =>" part is encode as a for-all
-type with a coercion variable that is never mentioned.
-
-We could instead have used a FunTy with an EqPred on the 
-left.  But we want 
-
-  * FunTy to mean RUN-TIME abstraction,
-    passing a real value at runtime, 
-
-  * ForAllTy to mean COMPILE-TIME abstraction, 
-    erased at runtime
-
 -------------------------------------
  		Note [PredTy]
 
@@ -603,46 +592,6 @@ ppr_forall_type p ty
     split2 ps (PredTy p `FunTy` ty) = split2 (p:ps) ty
     split2 ps ty		    = (reverse ps, ty)
 
-ppr_tc_app :: Prec -> TyCon -> [Type] -> SDoc
-ppr_tc_app _ tc []
-  = ppr_tc tc
-ppr_tc_app _ tc [ty]
-  | tc `hasKey` listTyConKey = brackets (pprType ty)
-  | tc `hasKey` parrTyConKey = ptext (sLit "[:") <> pprType ty <> ptext (sLit ":]")
-  | tc `hasKey` liftedTypeKindTyConKey   = ptext (sLit "*")
-  | tc `hasKey` unliftedTypeKindTyConKey = ptext (sLit "#")
-  | tc `hasKey` openTypeKindTyConKey     = ptext (sLit "(?)")
-  | tc `hasKey` ubxTupleKindTyConKey     = ptext (sLit "(#)")
-  | tc `hasKey` argTypeKindTyConKey      = ptext (sLit "??")
-
-ppr_tc_app p tc tys
-  | isTupleTyCon tc && tyConArity tc == length tys
-  = tupleParens (tupleTyConBoxity tc) (sep (punctuate comma (map pprType tys)))
-  | otherwise
-  = ppr_type_app p (getName tc) tys
-
-ppr_type_app :: Prec -> Name -> [Type] -> SDoc
--- Used for classes as well as types; that's why it's separate from ppr_tc_app
-ppr_type_app p tc tys
-  | is_sym_occ		-- Print infix if possible
-  , [ty1,ty2] <- tys	-- We know nothing of precedence though
-  = maybeParen p FunPrec (sep [ppr_type FunPrec ty1, 
-			       pprInfixVar True (ppr tc) <+> ppr_type FunPrec ty2])
-  | otherwise
-  = maybeParen p TyConPrec (hang (pprPrefixVar is_sym_occ (ppr tc))
-    	       	 	       2 (sep (map pprParendType tys)))
-  where
-    is_sym_occ = isSymOcc (getOccName tc)
-
-ppr_tc :: TyCon -> SDoc	-- No brackets for SymOcc
-ppr_tc 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
-
 ppr_tvar :: TyVar -> SDoc
 ppr_tvar tv  -- Note [Infix type variables]
   | isSymOcc (getOccName tv)  = parens (ppr tv)