diff options
author | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-10-11 08:43:37 -0400 |
---|---|---|
committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-10-11 08:43:37 -0400 |
commit | 9c3f73168a6f7f6632b6a3ffd2cfcd774976a7f1 (patch) | |
tree | a4948cc0902b35453e49b39015463f92d762ba1f /compiler | |
parent | f20cf982f126aea968ed6a482551550ffb6650cf (diff) | |
download | haskell-9c3f73168a6f7f6632b6a3ffd2cfcd774976a7f1.tar.gz |
Fix #10816 by renaming FixitySigs more consistently
Summary:
#10816 surfaced because we were renaming top-level fixity
declarations with a different code path (`rnSrcFixityDecl`) than
the code path for fixity declarations inside of type classes, which
is not privy to names that exist in the type namespace. Luckily, the
fix is simple: use `rnSrcFixityDecl` in both places.
Test Plan: make test TEST=T10816
Reviewers: austin, bgamari, simonpj
Reviewed By: simonpj
Subscribers: simonpj, rwbarton, thomie
GHC Trac Issues: #10816
Differential Revision: https://phabricator.haskell.org/D4077
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/rename/RnBinds.hs | 41 | ||||
-rw-r--r-- | compiler/rename/RnSource.hs | 42 |
2 files changed, 38 insertions, 45 deletions
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs index bf3ee26ae7..02a37b20ef 100644 --- a/compiler/rename/RnBinds.hs +++ b/compiler/rename/RnBinds.hs @@ -21,7 +21,7 @@ module RnBinds ( -- Other bindings rnMethodBinds, renameSigs, - rnMatchGroup, rnGRHSs, rnGRHS, + rnMatchGroup, rnGRHSs, rnGRHS, rnSrcFixityDecl, makeMiniFixityEnv, MiniFixityEnv, HsSigCtxt(..) ) where @@ -941,7 +941,6 @@ renameSigs ctxt sigs -- Doesn't seem worth much trouble to sort this. renameSig :: HsSigCtxt -> Sig GhcPs -> RnM (Sig GhcRn, FreeVars) --- FixitySig is renamed elsewhere. renameSig _ (IdSig x) = return (IdSig x, emptyFVs) -- Actually this never occurs @@ -988,9 +987,9 @@ renameSig ctxt sig@(InlineSig v s) = do { new_v <- lookupSigOccRn ctxt sig v ; return (InlineSig new_v s, emptyFVs) } -renameSig ctxt sig@(FixSig (FixitySig vs f)) - = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs - ; return (FixSig (FixitySig new_vs f), emptyFVs) } +renameSig ctxt (FixSig fsig) + = do { new_fsig <- rnSrcFixityDecl ctxt fsig + ; return (FixSig new_fsig, emptyFVs) } renameSig ctxt sig@(MinimalSig s (L l bf)) = do new_bf <- traverse (lookupSigOccRn ctxt sig) bf @@ -1223,6 +1222,38 @@ rnGRHS' ctxt rnBody (GRHS guards rhs) is_standard_guard _ = False {- +********************************************************* +* * + Source-code fixity declarations +* * +********************************************************* +-} + +rnSrcFixityDecl :: HsSigCtxt -> FixitySig GhcPs -> RnM (FixitySig GhcRn) +-- Rename a fixity decl, so we can put +-- the renamed decl in the renamed syntax tree +-- Errors if the thing being fixed is not defined locally. +rnSrcFixityDecl sig_ctxt = rn_decl + where + rn_decl :: FixitySig GhcPs -> RnM (FixitySig GhcRn) + -- GHC extension: look up both the tycon and data con + -- for con-like things; hence returning a list + -- If neither are in scope, report an error; otherwise + -- return a fixity sig for each (slightly odd) + rn_decl (FixitySig fnames fixity) + = do names <- concatMapM lookup_one fnames + return (FixitySig names fixity) + + lookup_one :: Located RdrName -> RnM [Located Name] + lookup_one (L name_loc rdr_name) + = setSrcSpan name_loc $ + -- This lookup will fail if the name is not defined in the + -- same binding group as this fixity declaration. + do names <- lookupLocalTcNames sig_ctxt what rdr_name + return [ L name_loc name | (_, name) <- names ] + what = text "fixity signature" + +{- ************************************************************************ * * \subsection{Error messages} diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index b47686ebfa..b182382381 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -177,7 +177,8 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, -- Rename fixity declarations and error if we try to -- fix something from another module (duplicates were checked in (A)) let { all_bndrs = tc_bndrs `unionNameSet` val_bndr_set } ; - rn_fix_decls <- rnSrcFixityDecls all_bndrs fix_decls ; + rn_fix_decls <- mapM (mapM (rnSrcFixityDecl (TopSigCtxt all_bndrs))) + fix_decls ; -- Rename deprec decls; -- check for duplicates and ensure that deprecated things are defined locally @@ -266,45 +267,6 @@ rnDocDecl (DocGroup lev doc) = do {- ********************************************************* * * - Source-code fixity declarations -* * -********************************************************* --} - -rnSrcFixityDecls :: NameSet -> [LFixitySig GhcPs] -> RnM [LFixitySig GhcRn] --- Rename the fixity decls, so we can put --- the renamed decls in the renamed syntax tree --- Errors if the thing being fixed is not defined locally. --- --- The returned FixitySigs are not actually used for anything, --- except perhaps the GHCi API -rnSrcFixityDecls bndr_set fix_decls - = do fix_decls <- mapM rn_decl fix_decls - return (concat fix_decls) - where - sig_ctxt = TopSigCtxt bndr_set - - rn_decl :: LFixitySig GhcPs -> RnM [LFixitySig GhcRn] - -- GHC extension: look up both the tycon and data con - -- for con-like things; hence returning a list - -- If neither are in scope, report an error; otherwise - -- return a fixity sig for each (slightly odd) - rn_decl (L loc (FixitySig fnames fixity)) - = do names <- mapM lookup_one fnames - return [ L loc (FixitySig name fixity) - | name <- names ] - - lookup_one :: Located RdrName -> RnM [Located Name] - lookup_one (L name_loc rdr_name) - = setSrcSpan name_loc $ - -- this lookup will fail if the definition isn't local - do names <- lookupLocalTcNames sig_ctxt what rdr_name - return [ L name_loc name | (_, name) <- names ] - what = text "fixity signature" - -{- -********************************************************* -* * Source-code deprecations declarations * * ********************************************************* |