[project @ 2000-12-07 08:22:53 by simonpj]

[ghc-hetmet.git] / ghc / compiler / hsSyn / HsBinds.lhs

diff --git a/ghc/compiler/hsSyn/HsBinds.lhs b/ghc/compiler/hsSyn/HsBinds.lhs
index 2d72e03..2cea4d2 100644 (file)
--- a/ghc/compiler/hsSyn/HsBinds.lhs
+++ b/ghc/compiler/hsSyn/HsBinds.lhs
@@ -16,14 +16,17 @@ import {-# SOURCE #-} HsMatches ( pprMatches, Match, pprGRHSs, GRHSs )
 -- friends:
 import HsTypes         ( HsType )
 import CoreSyn         ( CoreExpr )
+import PprCore         ( {- instance Outputable (Expr a) -} )
 
 --others:
-import Name            ( Name, isUnboundName )
+import Name            ( Name )
+import PrelNames       ( isUnboundName )
 import NameSet         ( NameSet, elemNameSet, nameSetToList )
 import BasicTypes      ( RecFlag(..), Fixity )
 import Outputable      
 import SrcLoc          ( SrcLoc )
 import Var             ( TyVar )
+import Class            ( DefMeth (..) )
 \end{code}
 
 %************************************************************************
@@ -71,16 +74,18 @@ instance (Outputable pat, Outputable id) =>
 
 ppr_binds EmptyBinds = empty
 ppr_binds (ThenBinds binds1 binds2)
-     = ($$) (ppr_binds binds1) (ppr_binds binds2)
+    = ppr_binds binds1 $$ ppr_binds binds2
 ppr_binds (MonoBind bind sigs is_rec)
-     = vcat [ifNotPprForUser (ptext rec_str),
+     = vcat [ppr_isrec,
             vcat (map ppr sigs),
             ppr bind
        ]
      where
-       rec_str = case is_rec of
-                  Recursive    -> SLIT("{- rec -}")
-                  NonRecursive -> SLIT("{- nonrec -}")
+       ppr_isrec = getPprStyle $ \ sty -> 
+                  if userStyle sty then empty else
+                  case is_rec of
+                       Recursive    -> ptext SLIT("{- rec -}")
+                       NonRecursive -> ptext SLIT("{- nonrec -}")
 \end{code}
 
 %************************************************************************
@@ -236,10 +241,11 @@ data Sig name
                SrcLoc
 
   | ClassOpSig name            -- Selector name
-               (Maybe          -- Nothing for source-file class signatures
-                     (name,            -- Default-method name (if any)
-                      Bool))           -- True <=> there is an explicit, programmer-supplied
-                                       --          default declaration in the class decl
+                (DefMeth name) -- (Just dm_name) for source-file class signatures
+                               --      The name may not be used, if there isn't a
+                               --      generic default method, but it's there if we
+                               --      need it
+                               -- Gives DefMeth info for interface files sigs
                (HsType name)
                SrcLoc
 
@@ -337,8 +343,9 @@ ppr_sig (ClassOpSig var dm ty _)
       = sep [ppr var <+> pp_dm <+> dcolon, nest 4 (ppr ty)]
       where
        pp_dm = case dm of 
-                 Just (_, True) -> equals      -- Default-method indicator
-                 other          -> empty
+                 DefMeth _  -> equals  -- Default method indicator
+                 GenDefMeth -> semi    -- Generic method indicator
+                 NoDefMeth  -> empty   -- No Method at all
 
 ppr_sig (SpecSig var ty _)
       = sep [ hsep [text "{-# SPECIALIZE", ppr var, dcolon],