X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsTypes.lhs;h=55369283c8c989f9496bff0418b30a353ebfdfc5;hp=ad7facb11eca767f365fe2725ab1c85fe681875e;hb=7fc749a43b4b6b85d234fa95d4928648259584f4;hpb=190f24892156953d73b55401d0467a6f1a88ce5d

diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs
index ad7facb..5536928 100644
--- a/compiler/hsSyn/HsTypes.lhs
+++ b/compiler/hsSyn/HsTypes.lhs
@@ -1,9 +1,18 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-\section[HsTypes]{Abstract syntax: user-defined types}
+
+HsTypes: Abstract syntax: user-defined types
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module HsTypes (
 	HsType(..), LHsType, 
 	HsTyVarBndr(..), LHsTyVarBndr,
@@ -30,14 +39,11 @@ module HsTypes (
 
 import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
 
-import Type		( Type )
-import {- Kind parts of -} 
-       Type	        ( {- instance Outputable Kind -} Kind,
-			  pprParendKind, pprKind, isLiftedTypeKind )
-import HsDoc            ( LHsDoc, HsDoc )
-import BasicTypes	( IPName, Boxity, tupleParens )
-import SrcLoc		( Located(..), unLoc, noSrcSpan )
-import StaticFlags	( opt_PprStyle_Debug )
+import Type
+import HsDoc
+import BasicTypes
+import SrcLoc
+import StaticFlags
 import Outputable
 \end{code}
 
@@ -103,7 +109,8 @@ type HsContext name = [LHsPred name]
 
 type LHsPred name = Located (HsPred name)
 
-data HsPred name = HsClassP name [LHsType name]
+data HsPred name = HsClassP name [LHsType name]		 -- class constraint
+		 | HsEqualP (LHsType name) (LHsType name)-- equality constraint
 		 | HsIParam (IPName name) (LHsType name)
 
 type LHsType name = Located (HsType name)
@@ -269,9 +276,6 @@ splitHsFunType other 	   	   = ([], other)
 %*									*
 %************************************************************************
 
-NB: these types get printed into interface files, so 
-    don't change the printing format lightly
-
 \begin{code}
 instance (OutputableBndr name) => Outputable (HsType name) where
     ppr ty = pprHsType ty
@@ -281,8 +285,13 @@ instance (Outputable name) => Outputable (HsTyVarBndr name) where
     ppr (KindedTyVar name kind) = pprHsTyVarBndr name kind
 
 instance OutputableBndr name => Outputable (HsPred name) where
-    ppr (HsClassP clas tys) = ppr clas <+> hsep (map (pprParendHsType.unLoc) tys)
-    ppr (HsIParam n ty)    = hsep [ppr n, dcolon, ppr ty]
+    ppr (HsClassP clas tys) = ppr clas <+> hsep (map pprLHsType tys)
+    ppr (HsEqualP t1 t2)    = hsep [pprLHsType t1, ptext SLIT("~"), 
+				    pprLHsType t2]
+    ppr (HsIParam n ty)     = hsep [ppr n, dcolon, ppr ty]
+
+pprLHsType :: OutputableBndr name => LHsType name -> SDoc
+pprLHsType = pprParendHsType . unLoc
 
 pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
 pprHsTyVarBndr name kind | isLiftedTypeKind kind = ppr name
@@ -340,7 +349,6 @@ ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
   = maybeParen ctxt_prec pREC_FUN $
     sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
 
--- gaw 2004
 ppr_mono_ty ctxt_prec (HsBangTy b ty)     = ppr b <> ppr ty
 ppr_mono_ty ctxt_prec (HsTyVar name)      = ppr name
 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   = ppr_fun_ty ctxt_prec ty1 ty2
@@ -348,7 +356,7 @@ ppr_mono_ty ctxt_prec (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
 ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
 ppr_mono_ty ctxt_prec (HsListTy ty)	  = brackets (ppr_mono_lty pREC_TOP ty)
 ppr_mono_ty ctxt_prec (HsPArrTy ty)	  = pabrackets (ppr_mono_lty pREC_TOP ty)
-ppr_mono_ty ctxt_prec (HsPredTy pred)     = braces (ppr pred)
+ppr_mono_ty ctxt_prec (HsPredTy pred)     = ppr pred
 ppr_mono_ty ctxt_prec (HsNumTy n)         = integer n  -- generics only
 ppr_mono_ty ctxt_prec (HsSpliceTy s)      = pprSplice s