X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnHsSyn.lhs;h=f90eb76edd3b1331d0df89976ea3a99b45865c4d;hb=bbffa95af87bb66635aaffdaddcd31be063752dc;hp=3085cd1fff5be487781bc336feb53db1cc9da686;hpb=83eef621e4a4fbb6c1343304ec638cafd6c9dc09;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 3085cd1..f90eb76 100644
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -15,7 +15,6 @@ import TysWiredIn	( tupleTyCon, listTyCon, charTyCon )
 import Name		( Name, getName, isTyVarName )
 import NameSet
 import BasicTypes	( Boxity )
-import Maybes		( orElse )
 import Outputable
 \end{code}
 
@@ -36,6 +35,7 @@ type RenamedHsBinds		= HsBinds		Name RenamedPat
 type RenamedHsExpr		= HsExpr		Name RenamedPat
 type RenamedHsModule		= HsModule		Name RenamedPat
 type RenamedInstDecl		= InstDecl		Name RenamedPat
+type RenamedMatchContext	= HsMatchContext	Name
 type RenamedMatch		= Match			Name RenamedPat
 type RenamedMonoBinds		= MonoBinds		Name RenamedPat
 type RenamedPat			= InPat			Name
@@ -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,8 +76,7 @@ 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 (HsOpTy ty1 tycon ty2) = get ty1 `unionNameSets` get ty2 `unionNameSets`
@@ -99,9 +97,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}
 
@@ -114,12 +112,17 @@ 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 (ForeignType {})
+  = emptyFVs
+
 tyClDeclFVs (IfaceSig {tcdType = ty, tcdIdInfo = id_infos})
   = extractHsTyNames ty			`plusFV` 
     plusFVs (map hsIdInfoFVs id_infos)
@@ -127,31 +130,36 @@ 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)
 
-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 (ClassOpSig _ _ ty _) = extractHsTyNames ty
+hsSigFVs other		    = emptyFVs
 
 ----------------
 instDeclFVs (InstDecl inst_ty _ _ maybe_dfun _)
@@ -159,8 +167,9 @@ instDeclFVs (InstDecl inst_ty _ _ maybe_dfun _)
     (case maybe_dfun of { Just n -> unitFV n; Nothing -> emptyFVs })
 
 ----------------
-ruleDeclFVs (HsRule _ _ _ _ _ _) = emptyFVs
-ruleDeclFVs (IfaceRule _ vars _ args rhs _)
+ruleDeclFVs (HsRule _ _ _ _ _ _ _) = emptyFVs
+ruleDeclFVs (IfaceRuleOut _ _)	   = emptyFVs
+ruleDeclFVs (IfaceRule _ _ vars _ args rhs _)
   = delFVs (map ufBinderName vars) $
     ufExprFVs rhs `plusFV` plusFVs (map ufExprFVs args)
 
@@ -178,14 +187,14 @@ bangTyFVs bty = extractHsTyNames (getBangType bty)
 
 ----------------
 hsIdInfoFVs (HsUnfold _ unf) = ufExprFVs unf
-hsIdInfoFVs (HsWorker n)     = unitFV n
+hsIdInfoFVs (HsWorker n a)   = unitFV n
 hsIdInfoFVs other	     = emptyFVs
 
 ----------------
 ufExprFVs (UfVar n) 	  = unitFV n
 ufExprFVs (UfLit l) 	  = emptyFVs
 ufExprFVs (UfLitLit l ty) = extractHsTyNames ty
-ufExprFVs (UfCCall cc ty) = extractHsTyNames ty
+ufExprFVs (UfFCall cc ty) = extractHsTyNames ty
 ufExprFVs (UfType ty)     = extractHsTyNames ty
 ufExprFVs (UfTuple tc es) = hsTupConFVs tc `plusFV` plusFVs (map ufExprFVs es)
 ufExprFVs (UfLam v e)     = ufBndrFVs v (ufExprFVs e)
@@ -210,7 +219,7 @@ ufConFVs other		    = emptyFVs
 ufNoteFVs (UfCoerce ty) = extractHsTyNames ty
 ufNoteFVs note		= emptyFVs
 
-hsTupConFVs (HsTupCon n _) = unitFV n
+hsTupConFVs (HsTupCon n _ _) = unitFV n
 \end{code}
 
 %************************************************************************