From f39ff24bc78da5ba09db8864ecbd7d1055b332db Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Sun, 22 Oct 2006 00:49:04 +0000 Subject: [PATCH] Fix handling of family instances in the presense of this doc stuff - Not sure whether I do the right thing, because I don't understand the doc stuff. However, the original code was definitely wrong and breaking the renaming of family instance declarations. - The important point is that in data instance T pats = rhs T is *not* a defining occurence of T (similarly as C is not a defining occurence in "instance C Int"). --- compiler/parser/RdrHsSyn.lhs | 2 ++ compiler/rename/RnEnv.lhs | 23 +++++++++++------------ compiler/rename/RnSource.lhs | 4 ++++ 3 files changed, 17 insertions(+), 12 deletions(-) diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 8e4570a..28f8fcb 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -309,6 +309,8 @@ add gp@(HsGroup {hs_tyclds = ts, hs_fixds = fs, hs_docs = docs}) addl (gp { hs_tyclds = L l d : ts, hs_fixds = fsigs ++ fs, hs_docs = add_doc decl docs}) ds + | isIdxTyDecl d = + addl (gp { hs_tyclds = L l d : ts }) ds | otherwise = addl (gp { hs_tyclds = L l d : ts, hs_docs = add_doc decl docs }) ds diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index 76360ca..16c1b0b 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -179,7 +179,9 @@ lookupTopBndrRn rdr_name | otherwise = do { mb_gre <- lookupGreLocalRn rdr_name ; case mb_gre of - Nothing -> unboundName rdr_name + Nothing -> do + traceRn $ text "lookupTopBndrRn" + unboundName rdr_name Just gre -> returnM (gre_name gre) } -- lookupLocatedSigOccRn is used for type signatures and pragmas @@ -244,15 +246,10 @@ newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr) -- lookupFamInstDeclBndr :: Module -> Located RdrName -> RnM Name lookupFamInstDeclBndr mod lrdr_name@(L _ rdr_name) - | not (isSrcRdrName rdr_name) - = lookupImportedName rdr_name - - | otherwise - = -- First look up the name in the normal environment. - lookupGreRn_maybe rdr_name `thenM` \ mb_gre -> - case mb_gre of { - Just gre -> returnM (gre_name gre) ; - Nothing -> newTopSrcBinder mod lrdr_name } + = do { mb_gre <- lookupGreRn_maybe rdr_name + ; case mb_gre of + Just gre -> returnM (gre_name gre) ; + Nothing -> newTopSrcBinder mod lrdr_name } -------------------------------------------------- -- Occurrences @@ -297,7 +294,8 @@ lookupGlobalOccRn rdr_name if isQual rdr_name && mod == iNTERACTIVE then -- This test is not expensive, lookupQualifiedName rdr_name -- and only happens for failed lookups - else + else do + traceRn $ text "lookupGlobalOccRn" unboundName rdr_name } lookupImportedName :: RdrName -> TcRnIf m n Name @@ -353,7 +351,8 @@ lookupGreRn rdr_name ; case mb_gre of { Just gre -> return gre ; Nothing -> do - { name <- unboundName rdr_name + { traceRn $ text "lookupGreRn" + ; name <- unboundName rdr_name ; return (GRE { gre_name = name, gre_par = NoParent, gre_prov = LocalDef }) }}} diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs index 993db64..1cb8058 100644 --- a/compiler/rename/RnSource.lhs +++ b/compiler/rename/RnSource.lhs @@ -101,8 +101,10 @@ rnSrcDecls (HsGroup { hs_valds = val_decls, -- So we content ourselves with gathering uses only; that -- means we'll only report a declaration as unused if it isn't -- mentioned at all. Ah well. + traceRn (text "Start rnTyClDecls") ; (rn_tycl_decls, src_fvs1) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls ; + traceRn (text "finish rnTyClDecls") ; (rn_inst_decls, src_fvs2) <- mapFvRn (wrapLocFstM rnSrcInstDecl) inst_decls ; (rn_deriv_decls, src_fvs_deriv) @@ -118,7 +120,9 @@ rnSrcDecls (HsGroup { hs_valds = val_decls, -- the rnDocEntity stuff reports the errors again. failIfErrsM ; + traceRn (text "Start rnDocEntitys") ; rn_docs <- mapM rnDocEntity docs ; + traceRn (text "finish rnDocEntitys") ; let { rn_group = HsGroup { hs_valds = rn_val_decls, -- 1.7.10.4