Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/cfcddaae2382ddb7f6d6d71fd15501709defd3d7 >--------------------------------------------------------------- commit cfcddaae2382ddb7f6d6d71fd15501709defd3d7 Author: Simon Peyton Jones <[email protected]> Date: Fri Dec 23 17:27:24 2011 +0000 Make RnEnv.lookupBindGroupOcc work on Orig RdrNames Such names can come from Template Haskell; see Trac #5700 Easily fixed, happily. I also renamed lookupSubBndr to lookupSubBndrOcc, which is more descriptive. >--------------------------------------------------------------- compiler/rename/RnEnv.lhs | 20 +++++++++++++------- compiler/rename/RnPat.lhs | 2 +- 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index c919e46..4f36d03 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -20,7 +20,7 @@ module RnEnv ( HsSigCtxt(..), lookupLocalDataTcNames, lookupSigOccRn, lookupFixityRn, lookupTyFixityRn, - lookupInstDeclBndr, lookupSubBndr, greRdrName, + lookupInstDeclBndr, lookupSubBndrOcc, greRdrName, lookupSubBndrGREs, lookupConstructorFields, lookupSyntaxName, lookupSyntaxTable, lookupIfThenElse, lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe, @@ -267,7 +267,7 @@ lookupInstDeclBndr cls what rdr -- In an instance decl you aren't allowed -- to use a qualified name for the method -- (Although it'd make perfect sense.) - ; lookupSubBndr (ParentIs cls) doc rdr } + ; lookupSubBndrOcc (ParentIs cls) doc rdr } where doc = what <+> ptext (sLit "of class") <+> quotes (ppr cls) @@ -304,11 +304,11 @@ lookupConstructorFields con_name -- unambiguous because there is only one field id 'fld' in scope. -- But currently it's rejected. -lookupSubBndr :: Parent -- NoParent => just look it up as usual - -- ParentIs p => use p to disambiguate - -> SDoc -> RdrName - -> RnM Name -lookupSubBndr parent doc rdr_name +lookupSubBndrOcc :: Parent -- NoParent => just look it up as usual + -- ParentIs p => use p to disambiguate + -> SDoc -> RdrName + -> RnM Name +lookupSubBndrOcc parent doc rdr_name | Just n <- isExact_maybe rdr_name -- This happens in derived code = lookupExactOcc n @@ -323,6 +323,7 @@ lookupSubBndr parent doc rdr_name -- The latter does pickGREs, but we want to allow 'x' -- even if only 'M.x' is in scope [gre] -> do { addUsedRdrName gre (used_rdr_name gre) + -- Add a usage; this is an *occurrence* site ; return (gre_name gre) } [] -> do { addErr (unknownSubordinateErr doc rdr_name) ; return (mkUnboundName rdr_name) } @@ -669,6 +670,11 @@ lookupBindGroupOcc ctxt what rdr_name ; return (Right n') } -- Maybe we should check the side conditions -- but it's a pain, and Exact things only show -- up when you know what you are doing + + | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name + = do { n' <- lookupOrig rdr_mod rdr_occ + ; return (Right n') } + | otherwise = case ctxt of HsBootCtxt -> lookup_top diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs index 740acc4..7dd76bd 100644 --- a/compiler/rename/RnPat.lhs +++ b/compiler/rename/RnPat.lhs @@ -487,7 +487,7 @@ rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot } rn_fld pun_ok parent (HsRecField { hsRecFieldId = fld , hsRecFieldArg = arg , hsRecPun = pun }) - = do { fld'@(L loc fld_nm) <- wrapLocM (lookupSubBndr parent doc) fld + = do { fld'@(L loc fld_nm) <- wrapLocM (lookupSubBndrOcc parent doc) fld ; arg' <- if pun then do { checkErr pun_ok (badPun fld) ; return (L loc (mk_arg (mkRdrUnqual (nameOccName fld_nm)))) } _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
