From 5a763550bf31ce446812d89f4967b601f122d344 Mon Sep 17 00:00:00 2001 From: simonpj Date: Tue, 19 Dec 2000 17:32:45 +0000 Subject: [PATCH 1/1] [project @ 2000-12-19 17:32:44 by simonpj] Mainly rename rnDecl to rnSourceDecl; and add more tracing to renamer --- ghc/compiler/hsSyn/HsDecls.lhs | 2 +- ghc/compiler/rename/RnBinds.lhs | 2 +- ghc/compiler/rename/RnEnv.lhs | 2 +- ghc/compiler/rename/RnHsSyn.lhs | 2 +- ghc/compiler/rename/RnIfaces.lhs | 4 +++- ghc/compiler/rename/RnSource.lhs | 30 ++++++++++++++---------------- 6 files changed, 21 insertions(+), 21 deletions(-) diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs index bb5404e..58c14b9 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 -- 1.7.10.4