Commit 9c3f7316 authored by Ryan Scott's avatar Ryan Scott
Browse files

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
parent f20cf982
......@@ -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
......@@ -1222,6 +1221,38 @@ rnGRHS' ctxt rnBody (GRHS guards rhs)
is_standard_guard [L _ (BodyStmt _ _ _ _)] = True
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"
{-
************************************************************************
* *
......
......@@ -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
......@@ -263,45 +264,6 @@ rnDocDecl (DocGroup lev doc) = do
rn_doc <- rnHsDoc doc
return (DocGroup lev rn_doc)
{-
*********************************************************
* *
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"
{-
*********************************************************
* *
......
{-# LANGUAGE TypeOperators, TypeFamilies #-}
module T10816 where
class C a where
type a # b
infix 4 #
type a *** b
type a +++ b
infixr 5 ***, +++
(***), (+++) :: a -> a -> a
......@@ -139,6 +139,7 @@ test('T7969', [], run_command, ['$MAKE -s --no-print-directory T7969'])
test('T9127', normal, compile, [''])
test('T4426', normal, compile_fail, [''])
test('T9778', normal, compile, ['-fwarn-unticked-promoted-constructors'])
test('T10816', normal, compile, [''])
test('T11164', [], multimod_compile, ['T11164', '-v0'])
test('T11167', normal, compile, [''])
test('T11167_ambig', normal, compile, [''])
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment