[commit: ghc] master: Fix #10816 by renaming FixitySigs more consistently (9c3f731)
git at git.haskell.org
git at git.haskell.org
Wed Oct 11 12:58:01 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/9c3f73168a6f7f6632b6a3ffd2cfcd774976a7f1/ghc
>---------------------------------------------------------------
commit 9c3f73168a6f7f6632b6a3ffd2cfcd774976a7f1
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date: Wed Oct 11 08:43:37 2017 -0400
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
>---------------------------------------------------------------
9c3f73168a6f7f6632b6a3ffd2cfcd774976a7f1
compiler/rename/RnBinds.hs | 41 +++++++++++++++++++++---
compiler/rename/RnSource.hs | 42 ++-----------------------
testsuite/tests/rename/should_compile/T10816.hs | 11 +++++++
testsuite/tests/rename/should_compile/all.T | 1 +
4 files changed, 50 insertions(+), 45 deletions(-)
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index bf3ee26..02a37b2 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 b47686e..b182382 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
* *
*********************************************************
diff --git a/testsuite/tests/rename/should_compile/T10816.hs b/testsuite/tests/rename/should_compile/T10816.hs
new file mode 100644
index 0000000..3f8cc60
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T10816.hs
@@ -0,0 +1,11 @@
+{-# 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
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 0b46f90..4eb584f 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -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, [''])
More information about the ghc-commits
mailing list