From fd8400f7a7bcdde8fb6544b327561f00b4f0ade5 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Mon, 27 Nov 2000 16:10:29 +0000
Subject: [PATCH] [project @ 2000-11-27 16:10:29 by simonpj] Get default
 methods right

---
 ghc/compiler/hsSyn/HsDecls.lhs   |    7 +++----
 ghc/compiler/rename/RnHsSyn.lhs  |   14 ++++----------
 ghc/compiler/rename/RnSource.lhs |   18 ++++++++++++------
 3 files changed, 19 insertions(+), 20 deletions(-)

diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs
index a0955a0..07866a4 100644
--- a/ghc/compiler/hsSyn/HsDecls.lhs
+++ b/ghc/compiler/hsSyn/HsDecls.lhs
@@ -226,7 +226,7 @@ tyClDeclName tycl_decl = tcdName tycl_decl
 
 --------------------------------
 tyClDeclNames :: Eq name => TyClDecl name pat -> [(name, SrcLoc)]
--- Returns all the binding names of the decl, along with their SrcLocs
+-- Returns all the *binding* names of the decl, along with their SrcLocs
 -- The first one is guaranteed to be the name of the decl
 -- For record fields, the first one counts as the SrcLoc
 -- We use the equality to filter out duplicate field names
@@ -242,7 +242,7 @@ tyClDeclNames (TyData {tcdName = tc_name, tcdCons = cons, tcdLoc = loc})
 
 
 --------------------------------
--- The "system names" are extra implicit names.
+-- The "system names" are extra implicit names *bound* by the decl.
 -- They are kept in a list rather than a tuple 
 -- to make the renamer easier.
 
@@ -262,8 +262,7 @@ tyClDeclSysNames :: TyClDecl name pat -> [(name, SrcLoc)]
 -- or "system" names of the declaration
 
 tyClDeclSysNames (ClassDecl {tcdSysNames = names, tcdLoc = loc, tcdSigs = sigs})
-  = [(n,loc) | n <- names] ++ 
-    [(n,loc) | ClassOpSig _ (DefMeth n) _ loc <- sigs]
+  = [(n,loc) | n <- names]
 tyClDeclSysNames (TyData {tcdCons = cons, tcdSysNames = names, tcdLoc = loc})
   = [(n,loc) | n <- names] ++ 
     [(wkr_name,loc) | ConDecl _ wkr_name _ _ _ loc <- cons]
diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 3085cd1..efe24a3 100644
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -142,16 +142,10 @@ tyClDeclFVs (ClassDecl {tcdCtxt = context, tcdTyVars = tyvars, tcdFDs = fds, tcd
 ----------------
 hsSigsFVs sigs = plusFVs (map hsSigFVs sigs)
 
-hsSigFVs (Sig v ty _) 	    	    = extractHsTyNames ty `addOneFV` v
-hsSigFVs (SpecInstSig ty _) 	    = extractHsTyNames ty
-hsSigFVs (SpecSig v ty _)   	    = extractHsTyNames ty `addOneFV` v
-hsSigFVs (FixSig (FixitySig v _ _)) = unitFV v
-hsSigFVs (InlineSig v p _) 	    = unitFV v
-hsSigFVs (NoInlineSig v p _)	    = unitFV v
-hsSigFVs (ClassOpSig v dm ty _)	    = dmFVs dm `plusFV` extractHsTyNames ty `addOneFV` v
-
-dmFVs (DefMeth v) = unitFV v
-dmFVs other	  = emptyFVs
+hsSigFVs (Sig v ty _) 	    = extractHsTyNames ty
+hsSigFVs (SpecInstSig ty _) = extractHsTyNames ty
+hsSigFVs (SpecSig v ty _)   = extractHsTyNames ty
+hsSigFVs other		    = emptyFVs
 
 ----------------
 instDeclFVs (InstDecl inst_ty _ _ maybe_dfun _)
diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index fff5f92..543499e 100644
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -396,12 +396,18 @@ rnClassOp clas clas_tyvars clas_fds sig@(ClassOpSig op dm_stuff ty locn)
     returnRn (ClassOpSig op_name dm_stuff' new_ty locn)
 
 rnClassBinds :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
-  -- Rename the mbinds only; the rest is done already
-rnClassBinds (ClassDecl {tcdMeths = Nothing}) rn_cls_decl
-  = returnRn (rn_cls_decl, emptyFVs)	-- No meth binds; decl came from interface file
-
-rnClassBinds (ClassDecl {tcdMeths = Just mbinds})				-- Get mbinds from here
-	     rn_cls_decl@(ClassDecl {tcdTyVars = tyvars, tcdLoc = src_loc})	-- Everything else is here
+rnClassBinds (ClassDecl {tcdMeths = Nothing})
+ rn_cls_decl@(ClassDecl {tcdSigs = sigs})
+  -- No method bindings, so this class decl comes from an interface file, 
+  -- However we want to treat the default-method names as free (they should
+  -- be defined somewhere else).  [In source code this is not so; the class
+  -- decl will bind whatever default-methods are necessary.]
+  = returnRn (rn_cls_decl, mkFVs [v | ClassOpSig _ (DefMeth v) _ _ <- sigs])
+
+rnClassBinds (ClassDecl {tcdMeths = Just mbinds})		-- Get mbinds from here
+ rn_cls_decl@(ClassDecl {tcdTyVars = tyvars, tcdLoc = src_loc})	-- Everything else is here
+  -- There are some default-method bindings (abeit possibly empty) so 
+  -- this is a source-code class declaration
   = 	-- The newLocals call is tiresome: given a generic class decl
 	--	class C a where
 	--	  op :: a -> a
-- 
1.7.10.4