[project @ 2001-03-01 17:07:49 by simonpj]

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

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index fefcf7c..7d12987 100644 (file)
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -46,7 +46,6 @@ type RenamedSig                       = Sig                   Name
 type RenamedStmt               = Stmt                  Name RenamedPat
 type RenamedFixitySig          = FixitySig             Name
 type RenamedDeprecation                = DeprecDecl            Name
-type RenamedHsOverLit          = HsOverLit             Name
 \end{code}
 
 %************************************************************************
@@ -77,12 +76,9 @@ extractHsTyNames ty
   where
     get (HsAppTy ty1 ty2)      = get ty1 `unionNameSets` get ty2
     get (HsListTy ty)          = unitNameSet listTyCon_name `unionNameSets` get ty
-    get (HsTupleTy (HsTupCon n _) tys) = unitNameSet n
-                                        `unionNameSets` extractHsTyNames_s tys
+    get (HsTupleTy con tys)    = hsTupConFVs con `unionNameSets` extractHsTyNames_s tys
     get (HsFunTy ty1 ty2)      = get ty1 `unionNameSets` get ty2
     get (HsPredTy p)          = extractHsPredTyNames p
-    get (HsUsgForAllTy uv ty)  = get ty
-    get (HsUsgTy u ty)         = get ty
     get (HsOpTy ty1 tycon ty2) = get ty1 `unionNameSets` get ty2 `unionNameSets`
                                 unitNameSet tycon
     get (HsNumTy n)            = emptyNameSet
@@ -116,44 +112,52 @@ 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 name ty id_infos loc)
+tyClDeclFVs (IfaceSig {tcdType = ty, tcdIdInfo = id_infos})
   = extractHsTyNames ty                        `plusFV` 
     plusFVs (map hsIdInfoFVs id_infos)
 
-tyClDeclFVs (TyData _ context _ tyvars condecls _ derivings _ _ _)
+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` [])
 
-tyClDeclFVs (TySynonym _ tyvars ty _)
+tyClDeclFVs (TySynonym {tcdTyVars = tyvars, tcdSynRhs = ty})
   = delFVs (map hsTyVarName tyvars) (extractHsTyNames ty)
 
-tyClDeclFVs (ClassDecl context _ tyvars fds sigs _ _ src_loc)
+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)
 
-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 (Just (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 (ClassOpSig _ _ ty _) = extractHsTyNames ty
+hsSigFVs other             = emptyFVs
 
 ----------------
 instDeclFVs (InstDecl inst_ty _ _ maybe_dfun _)
@@ -162,9 +166,9 @@ instDeclFVs (InstDecl inst_ty _ _ maybe_dfun _)
 
 ----------------
 ruleDeclFVs (HsRule _ _ _ _ _ _) = emptyFVs
-ruleDeclFVs (IfaceRule _ vars _ _ rhs _)
+ruleDeclFVs (IfaceRule _ vars _ args rhs _)
   = delFVs (map ufBinderName vars) $
-    ufExprFVs rhs
+    ufExprFVs rhs `plusFV` plusFVs (map ufExprFVs args)
 
 ----------------
 conDeclFVs (ConDecl _ _ tyvars context details _)
@@ -212,7 +216,7 @@ ufConFVs other                  = emptyFVs
 ufNoteFVs (UfCoerce ty) = extractHsTyNames ty
 ufNoteFVs note         = emptyFVs
 
-hsTupConFVs (HsTupCon n _) = unitFV n
+hsTupConFVs (HsTupCon n _ _) = unitFV n
 \end{code}
 
 %************************************************************************