[project @ 2001-04-30 13:50:59 by panne]

[ghc-hetmet.git] / ghc / compiler / rename / RnHsSyn.lhs

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 50f448d..8f01d67 100644 (file)
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -10,12 +10,11 @@ module RnHsSyn where
 
 import HsSyn
 import HsCore
-import Class           ( FunDep )
+import Class           ( FunDep, DefMeth(..) )
 import TysWiredIn      ( tupleTyCon, listTyCon, charTyCon )
 import Name            ( Name, getName, isTyVarName )
 import NameSet
 import BasicTypes      ( Boxity )
-import Maybes          ( orElse )
 import Outputable
 \end{code}
 
@@ -46,7 +45,6 @@ type RenamedSig                       = Sig                   Name
 type RenamedStmt               = Stmt                  Name RenamedPat
 type RenamedFixitySig          = FixitySig             Name
 type RenamedDeprecation                = DeprecDecl            Name
-type RenamedHsOverLit          = HsOverLit             Name
 \end{code}
 
 %************************************************************************
@@ -98,9 +96,9 @@ extractHsCtxtTyNames ctxt = foldr (unionNameSets . extractHsPredTyNames) emptyNa
 
 -- You don't import or export implicit parameters,
 -- so don't mention the IP names
-extractHsPredTyNames (HsPClass cls tys)
+extractHsPredTyNames (HsClassP cls tys)
   = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
-extractHsPredTyNames (HsPIParam n ty)
+extractHsPredTyNames (HsIParam n ty)
   = extractHsTyNames ty
 \end{code}
 
@@ -113,10 +111,12 @@ extractHsPredTyNames (HsPIParam n ty)
 
 Return the Names that must be in scope if we are to use this declaration.
 In all cases this is set up for interface-file declarations:
-       - for class decls we ignroe the bindings
+       - for class decls we ignore the bindings
        - for instance decls likewise, plus the pragmas
        - for rule decls, we ignore HsRules
 
+       *** See "THE NAMING STORY" in HsDecls ****
+
 \begin{code}
 tyClDeclFVs :: RenamedTyClDecl -> NameSet
 tyClDeclFVs (IfaceSig {tcdType = ty, tcdIdInfo = id_infos})
@@ -126,17 +126,27 @@ tyClDeclFVs (IfaceSig {tcdType = ty, tcdIdInfo = id_infos})
 tyClDeclFVs (TyData {tcdCtxt = context, tcdTyVars = tyvars, tcdCons = condecls, tcdDerivs = derivings})
   = delFVs (map hsTyVarName tyvars) $
     extractHsCtxtTyNames context       `plusFV`
-    plusFVs (map conDeclFVs condecls)  `plusFV`
-    mkNameSet (derivings `orElse` [])
+    plusFVs (map conDeclFVs condecls)
 
 tyClDeclFVs (TySynonym {tcdTyVars = tyvars, tcdSynRhs = ty})
   = delFVs (map hsTyVarName tyvars) (extractHsTyNames ty)
 
-tyClDeclFVs (ClassDecl {tcdCtxt = context, tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs})
+tyClDeclFVs (ClassDecl {tcdCtxt = context, tcdTyVars = tyvars, tcdFDs = fds, 
+                       tcdSigs = sigs, tcdMeths = maybe_meths})
   = delFVs (map hsTyVarName tyvars) $
     extractHsCtxtTyNames context         `plusFV`
     plusFVs (map extractFunDepNames fds)  `plusFV`
-    hsSigsFVs sigs
+    hsSigsFVs sigs                       `plusFV`
+    dm_fvs
+  where
+    dm_fvs = case maybe_meths of
+               Nothing -> mkFVs [v | ClassOpSig _ (DefMeth v) _ _ <- sigs]
+                 -- No method bindings, so this class decl comes from an interface file, 
+                 -- So 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.]
+               Just _ -> emptyFVs      -- Source code, so the default methods
+                                       -- are *bound* not *free*
 
 ----------------
 hsSigsFVs sigs = plusFVs (map hsSigFVs sigs)
@@ -172,7 +182,7 @@ bangTyFVs bty = extractHsTyNames (getBangType bty)
 
 ----------------
 hsIdInfoFVs (HsUnfold _ unf) = ufExprFVs unf
-hsIdInfoFVs (HsWorker n)     = unitFV n
+hsIdInfoFVs (HsWorker n a)   = unitFV n
 hsIdInfoFVs other           = emptyFVs
 
 ----------------