[project @ 2000-11-27 16:10:29 by simonpj]

Get default methods right

diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs
index a0955a0..07866a4 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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