Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/0f6ab7766e8cd131ed50c76f3a381ee690c3a010 >--------------------------------------------------------------- commit 0f6ab7766e8cd131ed50c76f3a381ee690c3a010 Author: Simon Peyton Jones <[email protected]> Date: Wed Nov 2 10:18:00 2011 +0000 Fix Trac #5592: unused-import warnings with dot-dot notation A subtle interaction between two complicate features! >--------------------------------------------------------------- compiler/rename/RnEnv.lhs | 20 +++++++++++++----- compiler/rename/RnPat.lhs | 48 +++++++++++++++++++++++++------------------- 2 files changed, 41 insertions(+), 27 deletions(-) diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index a700711..bcc7d65 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -13,7 +13,7 @@ module RnEnv ( HsSigCtxt(..), lookupLocalDataTcNames, lookupSigOccRn, lookupFixityRn, lookupTyFixityRn, - lookupInstDeclBndr, lookupSubBndr, + lookupInstDeclBndr, lookupSubBndr, greRdrName, lookupSubBndrGREs, lookupConstructorFields, lookupSyntaxName, lookupSyntaxTable, lookupIfThenElse, lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe, @@ -323,18 +323,26 @@ lookupSubBndr parent doc rdr_name -- Note [Usage for sub-bndrs] used_rdr_name gre | isQual rdr_name = rdr_name - | otherwise = case gre_prov gre of - LocalDef -> rdr_name - Imported is -> used_rdr_name_from_is is + | otherwise = greRdrName gre + +greRdrName :: GlobalRdrElt -> RdrName +greRdrName gre + = case gre_prov gre of + LocalDef -> unqual_rdr + Imported is -> used_rdr_name_from_is is + + where + occ = nameOccName (gre_name gre) + unqual_rdr = mkRdrUnqual occ used_rdr_name_from_is imp_specs -- rdr_name is unqualified | not (all (is_qual . is_decl) imp_specs) - = rdr_name -- An unqualified import is available + = unqual_rdr -- An unqualified import is available | otherwise = -- Only qualified imports available, so make up -- a suitable qualifed name from the first imp_spec ASSERT( not (null imp_specs) ) - mkRdrQual (is_as (is_decl (head imp_specs))) (rdrNameOcc rdr_name) + mkRdrQual (is_as (is_decl (head imp_specs))) occ lookupSubBndrGREs :: GlobalRdrEnv -> Parent -> RdrName -> [GlobalRdrElt] -- If Parent = NoParent, just do a normal lookup diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs index a6f619a..b24815a 100644 --- a/compiler/rename/RnPat.lhs +++ b/compiler/rename/RnPat.lhs @@ -509,31 +509,37 @@ rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot } ; let present_flds = getFieldIds flds parent_tc = find_tycon rdr_env con - -- Only fill in fields whose selectors are in scope (somehow) - fld_in_scope fld = not (null (lookupGRE_Name rdr_env fld)) - - -- For constructor uses, the arg should be in scope (unqualified) + -- For constructor uses (but not patterns) + -- the arg should be in scope (unqualified) -- ignoring the record field itself -- Eg. data R = R { x,y :: Int } -- f x = R { .. } -- Should expand to R {x=x}, not R{x=x,y=y} - arg_in_scope rdr = rdr `elemLocalRdrEnv` lcl_env - || notNull [ gre | gre <- lookupGRE_RdrName rdr rdr_env - , case gre_par gre of - ParentIs p -> p /= parent_tc - _ -> True ] - + arg_in_scope fld + = rdr `elemLocalRdrEnv` lcl_env + || notNull [ gre | gre <- lookupGRE_RdrName rdr rdr_env + , case gre_par gre of + ParentIs p -> p /= parent_tc + _ -> True ] + where + rdr = mkRdrUnqual (nameOccName fld) + + dot_dot_gres = [ gre + | fld <- con_fields + , not (fld `elem` present_flds) + , let gres@(gre:_) = lookupGRE_Name rdr_env fld + , not (null gres) + , case ctxt of + HsRecFieldCon {} -> arg_in_scope fld + _other -> True ] + + ; addUsedRdrNames (map greRdrName dot_dot_gres) ; return [ HsRecField - { hsRecFieldId = loc_f - , hsRecFieldArg = L loc (mk_arg arg_rdr) - , hsRecPun = False } - | f <- con_fields - , let loc_f = L loc f - arg_rdr = mkRdrUnqual (nameOccName f) - , not (f `elem` present_flds) - , fld_in_scope f - , case ctxt of - HsRecFieldCon {} -> arg_in_scope arg_rdr - _other -> True ] } + { hsRecFieldId = L loc fld + , hsRecFieldArg = L loc (mk_arg arg_rdr) + , hsRecPun = False } + | gre <- dot_dot_gres + , let fld = gre_name gre + arg_rdr = mkRdrUnqual (nameOccName fld) ] } check_disambiguation :: Bool -> Maybe Name -> RnM Parent -- When disambiguation is on, _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
