X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsBinds.lhs;h=211a3c156007ed4d24bddc1776debe5898704b9a;hb=43a2e4a26175b9dbf29e39b97f7d032ef00f9993;hp=8e10667643ba44b0b840b7f0cc85dcd533d90461;hpb=6a05ec5ef5373f61b7f9f5bdc344483417fa801b;p=ghc-hetmet.git

diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs
index 8e10667..211a3c1 100644
--- a/compiler/hsSyn/HsBinds.lhs
+++ b/compiler/hsSyn/HsBinds.lhs
@@ -264,7 +264,7 @@ instance (OutputableBndr idL, OutputableBndr idR) => Outputable (HsBindLR idL id
 ppr_monobind :: (OutputableBndr idL, OutputableBndr idR) => HsBindLR idL idR -> SDoc
 
 ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })      = pprPatBind pat grhss
-ppr_monobind (VarBind { var_id = var, var_rhs = rhs })         = ppr var <+> equals <+> pprExpr (unLoc rhs)
+ppr_monobind (VarBind { var_id = var, var_rhs = rhs })         = pprBndr CaseBind var <+> equals <+> pprExpr (unLoc rhs)
 ppr_monobind (FunBind { fun_id = fun, fun_infix = inf,
 			fun_matches = matches,
 		        fun_tick = tick }) = 
@@ -343,8 +343,9 @@ data HsWrapper
 
   | WpApp Var			-- [] d		the 'd' is a type-class dictionary
   | WpTyApp Type		-- [] t		the 't' is a type or corecion
-  | WpLam Id	 		-- \d. []	the 'd' is a type-class dictionary
-  | WpTyLam TyVar 		-- \a. []	the 'a' is a type or coercion variable
+  | WpLam Var	 		-- \d. []	the 'd' is a type-class dictionary or coercion variable
+  | WpTyLam TyVar 		-- \a. []	the 'a' is a type variable (not coercion var)
+  | WpInline			-- inline_me []   Wrap inline around the thing
 
 	-- Non-empty bindings, so that the identity coercion
 	-- is always exactly WpHole
@@ -365,6 +366,7 @@ pprHsWrapper it wrap =
         help it (WpLam id)    = sep [ptext SLIT("\\") <> pprBndr LambdaBind id <> dot, it]
         help it (WpTyLam tv)  = sep [ptext SLIT("/\\") <> pprBndr LambdaBind tv <> dot, it]
         help it (WpLet binds) = sep [ptext SLIT("let") <+> braces (ppr binds), it]
+        help it WpInline      = sep [ptext SLIT("_inline_me_"), it]
     in
       -- in debug mode, print the wrapper
       -- otherwise just print what's inside
@@ -452,9 +454,6 @@ data Prag
   | SpecPrag   
 	(HsExpr Id)	-- An expression, of the given specialised type, which
 	PostTcType 	-- specialises the polymorphic function
-	[Id]		-- Dicts mentioned free in the expression
-			--   Apr07: I think this is pretty useless
-			--	    see Note [Const rule dicts] in DsBinds
 	InlineSpec 	-- Inlining spec for the specialised function
 
 isInlinePrag (InlinePrag _) = True
@@ -529,7 +528,7 @@ isInlineLSig other		  = False
 
 hsSigDoc (TypeSig {}) 		= ptext SLIT("type signature")
 hsSigDoc (SpecSig {})	 	= ptext SLIT("SPECIALISE pragma")
-hsSigDoc (InlineSig _ spec)   	= ppr spec <+> ptext SLIT("pragma")
+hsSigDoc (InlineSig _ spec)   	= ptext SLIT("INLINE pragma")
 hsSigDoc (SpecInstSig {})	= ptext SLIT("SPECIALISE instance pragma")
 hsSigDoc (FixSig {}) 		= ptext SLIT("fixity declaration")
 \end{code}
@@ -540,7 +539,7 @@ Signature equality is used when checking for duplicate signatures
 eqHsSig :: LSig Name -> LSig Name -> Bool
 eqHsSig (L _ (FixSig (FixitySig n1 _))) (L _ (FixSig (FixitySig n2 _))) = unLoc n1 == unLoc n2
 eqHsSig (L _ (TypeSig n1 _))         	(L _ (TypeSig n2 _))            = unLoc n1 == unLoc n2
-eqHsSig (L _ (InlineSig n1 s1))	(L _ (InlineSig n2 s2))    	        = s1 == s2 && unLoc n1 == unLoc n2
+eqHsSig (L _ (InlineSig n1 s1))	(L _ (InlineSig n2 s2))    	        = unLoc n1 == unLoc n2
  	-- For specialisations, we don't have equality over
 	-- HsType, so it's not convenient to spot duplicate 
 	-- specialisations here.  Check for this later, when we're in Type land
@@ -571,7 +570,7 @@ pprSpec :: (Outputable id, Outputable ty) => id -> ty -> InlineSpec -> SDoc
 pprSpec var ty inl = sep [ptext SLIT("SPECIALIZE") <+> ppr inl <+> pprVarSig var ty]
 
 pprPrag :: Outputable id => id -> LPrag -> SDoc
-pprPrag var (L _ (InlinePrag inl))         = ppr inl <+> ppr var
-pprPrag var (L _ (SpecPrag expr ty _ inl)) = pprSpec var ty inl
+pprPrag var (L _ (InlinePrag inl))       = ppr inl <+> ppr var
+pprPrag var (L _ (SpecPrag expr ty inl)) = pprSpec var ty inl
 \end{code}