X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsBinds.lhs;h=5a0da8f5bdd5f10c76a3e8a8b277d77593eec4ea;hb=b89373082160548225901a4963523fac8c977a15;hp=458a713daddf017087e03307fb2c49101a3f1b11;hpb=1796a476986f14cca2f7628d2f7cf6d530853495;p=ghc-hetmet.git

diff --git a/ghc/compiler/hsSyn/HsBinds.lhs b/ghc/compiler/hsSyn/HsBinds.lhs
index 458a713..5a0da8f 100644
--- a/ghc/compiler/hsSyn/HsBinds.lhs
+++ b/ghc/compiler/hsSyn/HsBinds.lhs
@@ -11,21 +11,18 @@ module HsBinds where
 #include "HsVersions.h"
 
 import {-# SOURCE #-} HsExpr ( HsExpr, pprExpr, LHsExpr,
-			       LMatch, pprFunBind,
+			       MatchGroup, pprFunBind,
 			       GRHSs, pprPatBind )
+import {-# SOURCE #-} HsPat  ( LPat )
 
--- friends:
-import HsPat		( LPat )
-import HsTypes		( LHsType )
-
---others:
+import HsTypes		( LHsType, PostTcType )
 import Name		( Name )
 import NameSet		( NameSet, elemNameSet, nameSetToList )
 import BasicTypes	( IPName, RecFlag(..), Activation(..), Fixity )
 import Outputable	
 import SrcLoc		( Located(..), unLoc )
 import Var		( TyVar )
-import Bag		( Bag, bagToList )
+import Bag		( Bag, emptyBag, isEmptyBag, bagToList )
 \end{code}
 
 %************************************************************************
@@ -50,7 +47,10 @@ instance OutputableBndr id => Outputable (HsBindGroup id) where
   ppr (HsBindGroup binds sigs is_rec)
      = vcat [ppr_isrec,
      	     vcat (map ppr sigs),
-	     pprLHsBinds binds
+	     vcat (map ppr (bagToList binds))
+		-- *not* pprLHsBinds because we don't want braces; 'let' and
+		-- 'where' include a list of HsBindGroups and we don't want
+		-- several groups of bindings each with braces around.
        ]
      where
        ppr_isrec = getPprStyle $ \ sty -> 
@@ -78,11 +78,20 @@ instance (OutputableBndr id) => Outputable (IPBind id) where
 
 -- -----------------------------------------------------------------------------
 
-type LHsBinds id = Bag (LHsBind id)
-type LHsBind  id = Located (HsBind id)
+type LHsBinds id  = Bag (LHsBind id)
+type DictBinds id = LHsBinds id		-- Used for dictionary or method bindings
+type LHsBind  id  = Located (HsBind id)
+
+emptyLHsBinds :: LHsBinds id
+emptyLHsBinds = emptyBag
+
+isEmptyLHsBinds :: LHsBinds id -> Bool
+isEmptyLHsBinds = isEmptyBag
 
 pprLHsBinds :: OutputableBndr id => LHsBinds id -> SDoc
-pprLHsBinds binds = lbrace <+> vcat (map ppr (bagToList binds)) <+> rbrace
+pprLHsBinds binds 
+  | isEmptyLHsBinds binds = empty
+  | otherwise = lbrace <+> vcat (map ppr (bagToList binds)) <+> rbrace
 
 data HsBind id
   = FunBind     (Located id)
@@ -95,11 +104,12 @@ data HsBind id
 			-- FunBinds, so if you change this, you'll need to
 			-- change e.g. rnMethodBinds
 		Bool	-- True => infix declaration
-		[LMatch id]
+		(MatchGroup id)
 
   | PatBind     (LPat id)	-- The pattern is never a simple variable;
 				-- That case is done by FunBind
 		(GRHSs id)
+		PostTcType	-- Type of the GRHSs
 
   | VarBind id (Located (HsExpr id))	-- Dictionary binding and suchlike;
 					-- located only for consistency
@@ -149,7 +159,7 @@ instance OutputableBndr id => Outputable (HsBind id) where
 
 ppr_monobind :: OutputableBndr id => HsBind id -> SDoc
 
-ppr_monobind (PatBind pat grhss)       = pprPatBind pat grhss
+ppr_monobind (PatBind pat grhss ty)    = pprPatBind pat grhss
 ppr_monobind (VarBind var rhs)         = ppr var <+> equals <+> pprExpr (unLoc rhs)
 ppr_monobind (FunBind fun inf matches) = pprFunBind (unLoc fun) matches
       -- ToDo: print infix if appropriate
@@ -232,16 +242,20 @@ sigName (L _ sig) = f sig
     f (FixSig (FixitySig n _)) = Just (unLoc n)
     f other			= Nothing
 
-isFixitySig :: Sig name -> Bool
-isFixitySig (FixSig _) = True
-isFixitySig _	       = False
+isFixityLSig :: LSig name -> Bool
+isFixityLSig (L _ (FixSig _)) = True
+isFixityLSig _	              = False
+
+isVanillaLSig :: LSig name -> Bool
+isVanillaLSig (L _(Sig name _)) = True
+isVanillaLSig sig	        = False
 
-isPragSig :: Sig name -> Bool
+isPragLSig :: LSig name -> Bool
 	-- Identifies pragmas 
-isPragSig (SpecSig _ _)     = True
-isPragSig (InlineSig _ _ _) = True
-isPragSig (SpecInstSig _)   = True
-isPragSig other		    = False
+isPragLSig (L _ (SpecSig _ _))     = True
+isPragLSig (L _ (InlineSig _ _ _)) = True
+isPragLSig (L _ (SpecInstSig _))   = True
+isPragLSig other		   = False
 
 hsSigDoc (Sig        _ _) 	  = ptext SLIT("type signature")
 hsSigDoc (SpecSig    _ _) 	  = ptext SLIT("SPECIALISE pragma")