X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FIfaceSyn.lhs;h=b3dd586da6895bc2f5297e91f800b3b64efe41d3;hb=171c3d1ea2dc92a8b5e6e76c435286ce5be53386;hp=a4942ba3c90f19373062b84b99c10c20889df870;hpb=a835e9faf19400aa6b7999b6f64e60cb1c7737dd;p=ghc-hetmet.git

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index a4942ba..b3dd586 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -36,22 +36,17 @@ import CoreSyn
 import IfaceType
 
 import NewDemand	( StrictSig, pprIfaceStrictSig )
-import TcType		( deNoteType )
 import Class		( FunDep, DefMeth, pprFundeps )
 import OccName		( OccName, parenSymOcc, occNameFS,
-			  OccSet, unionOccSets, unitOccSet )
+			  OccSet, unionOccSets, unitOccSet, occSetElts )
 import UniqFM           ( UniqFM, emptyUFM, addToUFM, lookupUFM )
-import Name		( Name, NamedThing(..), nameOccName, isExternalName )
 import CostCentre	( CostCentre, pprCostCentreCore )
 import Literal		( Literal )
 import ForeignCall	( ForeignCall )
 import BasicTypes	( Arity, Activation(..), StrictnessMark, OverlapFlag,
-			  RecFlag(..), Boxity(..), 
-			  isAlwaysActive, tupleParens )
+			  RecFlag(..), Boxity(..), tupleParens )
 import Outputable
 import FastString
-import Maybes		( catMaybes )
-import Util		( lengthIs )
 
 infixl 3 &&&
 infix  4 `eqIfExt`, `eqIfIdInfo`, `eqIfType`
@@ -384,21 +379,22 @@ pprIfaceExpr add_par e@(IfaceLam _ _)
     collect bs (IfaceLam b e) = collect (b:bs) e
     collect bs e              = (reverse bs, e)
 
--- gaw 2004 
 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
--- gaw 2004
-  = add_par (sep [ptext SLIT("case") <+> char '@' <+> pprParendIfaceType ty <+> pprIfaceExpr noParens scrut <+> ptext SLIT("of") 
+  = add_par (sep [ptext SLIT("case") <+> char '@' <+> pprParendIfaceType ty
+			<+> pprIfaceExpr noParens scrut <+> ptext SLIT("of") 
 			<+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
   		  pprIfaceExpr noParens rhs <+> char '}'])
 
--- gaw 2004
 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
--- gaw 2004
-  = add_par (sep [ptext SLIT("case") <+> char '@' <+> pprParendIfaceType ty <+> pprIfaceExpr noParens scrut <+> ptext SLIT("of") 
+  = add_par (sep [ptext SLIT("case") <+> char '@' <+> pprParendIfaceType ty
+		 	<+> pprIfaceExpr noParens scrut <+> ptext SLIT("of") 
 			<+> ppr bndr <+> char '{',
   		  nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 
-pprIfaceExpr add_par (IfaceCast expr co) = add_par (ptext SLIT("cast") <+> ppr expr <+> ppr co)
+pprIfaceExpr add_par (IfaceCast expr co)
+  = sep [pprIfaceExpr parens expr,
+	 nest 2 (ptext SLIT("`cast`")),
+	 pprParendIfaceType co]
 
 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
   = add_par (sep [ptext SLIT("let {"), 
@@ -474,6 +470,11 @@ data IfaceEq
   | NotEqual		-- Definitely different
   | EqBut OccSet	-- The same provided these local things have not changed
 
+instance Outputable IfaceEq where
+  ppr Equal          = ptext SLIT("Equal")
+  ppr NotEqual       = ptext SLIT("NotEqual")
+  ppr (EqBut occset) = ptext SLIT("EqBut") <+> ppr (occSetElts occset)
+
 bool :: Bool -> IfaceEq
 bool True  = Equal
 bool False = NotEqual
@@ -730,7 +731,12 @@ eqIfTc IfaceBoolTc   IfaceBoolTc   = Equal
 eqIfTc IfaceListTc   IfaceListTc   = Equal
 eqIfTc IfacePArrTc   IfacePArrTc   = Equal
 eqIfTc (IfaceTupTc bx1 ar1) (IfaceTupTc bx2 ar2) = bool (bx1==bx2 && ar1==ar2)
-eqIfTc _ _ = NotEqual
+eqIfTc IfaceLiftedTypeKindTc   IfaceLiftedTypeKindTc   = Equal
+eqIfTc IfaceOpenTypeKindTc     IfaceOpenTypeKindTc     = Equal
+eqIfTc IfaceUnliftedTypeKindTc IfaceUnliftedTypeKindTc = Equal
+eqIfTc IfaceUbxTupleKindTc     IfaceUbxTupleKindTc     = Equal
+eqIfTc IfaceArgTypeKindTc      IfaceArgTypeKindTc      = Equal
+eqIfTc _		       _		       = NotEqual
 \end{code}
 
 -----------------------------------------------------------