[project @ 2000-12-19 17:32:44 by simonpj]

Mainly rename rnDecl to rnSourceDecl; and add more tracing to renamer

diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs
index bb5404e..58c14b9 100644 (file)
--- a/ghc/compiler/hsSyn/HsDecls.lhs
+++ b/ghc/compiler/hsSyn/HsDecls.lhs
@@ -261,7 +261,7 @@ tyClDeclSysNames :: TyClDecl name pat -> [(name, SrcLoc)]
 -- Similar to tyClDeclNames, but returns the "implicit" 
 -- or "system" names of the declaration
 
-tyClDeclSysNames (ClassDecl {tcdSysNames = names, tcdLoc = loc, tcdSigs = sigs})
+tyClDeclSysNames (ClassDecl {tcdSysNames = names, tcdLoc = loc})
   = [(n,loc) | n <- names]
 tyClDeclSysNames (TyData {tcdCons = cons, tcdSysNames = names, tcdLoc = loc})
   = [(n,loc) | n <- names] ++ 

diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs
index 1da2f9c..cf28052 100644 (file)
--- a/ghc/compiler/rename/RnBinds.lhs
+++ b/ghc/compiler/rename/RnBinds.lhs
@@ -385,7 +385,7 @@ rnMethodBinds gen_tyvars (FunMonoBind name inf matches locn)
     returnRn (FunMonoBind sel_name inf new_matches locn, fvs `addOneFV` sel_name)
   where
        -- Gruesome; bring into scope the correct members of the generic type variables
-       -- See comments in RnSource.rnDecl(ClassDecl)
+       -- See comments in RnSource.rnSourceDecl(ClassDecl)
     rn_match match@(Match _ (TypePatIn ty : _) _ _)
        = extendTyVarEnvFVRn gen_tvs (rnMatch match)
        where

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index de24b1a..9a7e56d 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -410,7 +410,7 @@ bindLocalsFVRn doc rdr_names enclosed_scope
 
 -------------------------------------
 extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
-       -- This tiresome function is used only in rnDecl on InstDecl
+       -- This tiresome function is used only in rnSourceDecl on InstDecl
 extendTyVarEnvFVRn tyvars enclosed_scope
   = bindLocalNames tyvars enclosed_scope       `thenRn` \ (thing, fvs) -> 
     returnRn (thing, delListFromNameSet fvs tyvars)

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 50f448d..3ad4a05 100644 (file)
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -113,7 +113,7 @@ 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
 

diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index 54ec9e6..21a2168 100644 (file)
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -595,6 +595,7 @@ data ImportDeclResult
 importDecl name
   =    -- STEP 1: Check if we've slurped it in while compiling this module
     getIfacesRn                                `thenRn` \ ifaces ->
+    traceRn (text "Wanting:" <+> ppr name)     `thenRn_`
     if name `elemNameSet` iSlurp ifaces then   
        returnRn AlreadySlurped 
     else
@@ -625,7 +626,8 @@ importDecl name
     in
     case lookupNameEnv decls_map name of
       Just (avail,_,decl)
-       -> setIfacesRn (recordSlurp ifaces avail)       `thenRn_`
+       -> traceRn (text "Record slurp" <+> ppr avail)  `thenRn_`
+          setIfacesRn (recordSlurp ifaces avail)       `thenRn_`
           returnRn (HereItIs decl)
 
       Nothing 

diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index a68f5d1..31330f6 100644 (file)
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -4,7 +4,7 @@
 \section[RnSource]{Main pass of renamer}
 
 \begin{code}
-module RnSource ( rnDecl, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl, rnSourceDecls, 
+module RnSource ( rnTyClDecl, rnIfaceRuleDecl, rnInstDecl, rnSourceDecls, 
                  rnHsType, rnHsSigType, rnHsTypeFVs, rnHsSigTypeFVs
        ) where
 
@@ -53,7 +53,7 @@ import CStrings               ( isCLabelString )
 import ListSetOps      ( removeDupsEq )
 \end{code}
 
-@rnDecl@ `renames' declarations.
+@rnSourceDecl@ `renames' declarations.
 It simultaneously performs dependency analysis and precedence parsing.
 It also does the following error checks:
 \begin{enumerate}
@@ -88,7 +88,7 @@ rnSourceDecls gbl_env local_fixity_env decls
     go fvs ds' []             = returnRn (ds', fvs)
     go fvs ds' (FixD _:ds)    = go fvs ds' ds
     go fvs ds' (DeprecD _:ds) = go fvs ds' ds
-    go fvs ds' (d:ds)         = rnDecl d       `thenRn` \(d', fvs') ->
+    go fvs ds' (d:ds)         = rnSourceDecl d `thenRn` \(d', fvs') ->
                                go (fvs `plusFV` fvs') (d':ds') ds
 \end{code}
 
@@ -100,38 +100,36 @@ rnSourceDecls gbl_env local_fixity_env decls
 %*********************************************************
 
 \begin{code}
--- rnDecl does all the work
-rnDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
+-- rnSourceDecl does all the work
+rnSourceDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
 
-rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
-                     returnRn (ValD new_binds, fvs)
+rnSourceDecl (ValD binds) = rnTopBinds binds   `thenRn` \ (new_binds, fvs) ->
+                           returnRn (ValD new_binds, fvs)
 
-rnDecl (TyClD tycl_decl)
+rnSourceDecl (TyClD tycl_decl)
   = rnTyClDecl tycl_decl               `thenRn` \ new_decl ->
     rnClassBinds tycl_decl new_decl    `thenRn` \ (new_decl', fvs) ->
+    traceRn (text "rnClassDecl:" <+> (ppr (nameSetToList (tyClDeclFVs new_decl')) $$
+                                     ppr (nameSetToList fvs)))         `thenRn_`
     returnRn (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
 
-rnDecl (InstD inst)
+rnSourceDecl (InstD inst)
   = rnInstDecl inst            `thenRn` \ new_inst ->
     rnInstBinds inst new_inst  `thenRn` \ (new_inst', fvs) ->
     returnRn (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
 
-rnDecl (RuleD rule)
-  | isIfaceRuleDecl rule
-  = rnIfaceRuleDecl rule       `thenRn` \ new_rule ->
-    returnRn (RuleD new_rule, ruleDeclFVs new_rule)
-  | otherwise
+rnSourceDecl (RuleD rule)
   = rnHsRuleDecl rule          `thenRn` \ (new_rule, fvs) ->
     returnRn (RuleD new_rule, fvs)
 
-rnDecl (DefD (DefaultDecl tys src_loc))
+rnSourceDecl (DefD (DefaultDecl tys src_loc))
   = pushSrcLocRn src_loc $
     mapFvRn (rnHsTypeFVs doc_str) tys          `thenRn` \ (tys', fvs) ->
     returnRn (DefD (DefaultDecl tys' src_loc), fvs)
   where
     doc_str = text "a `default' declaration"
 
-rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
+rnSourceDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
   = pushSrcLocRn src_loc $
     lookupOccRn name                   `thenRn` \ name' ->
     let