Commit d819e416 authored by Matthew Pickering's avatar Matthew Pickering
Browse files

Only use locally bound variables in pattern synonym declarations

Summary:
We were using the unconstrainted `lookupOccRn` function which looked up
any variable in scope. Instead we only want to consider variables brought into
scope by renaming the pattern on the RHS.

A few more changes to make reporting of unbound names suggest the correct
things.

Fixes #13470

Reviewers: simonpj, austin, bgamari

Reviewed By: simonpj

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D3377
parent a6ce7f33
......@@ -635,13 +635,13 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
case details of
PrefixPatSyn vars ->
do { checkDupRdrNames vars
; names <- mapM lookupVar vars
; names <- mapM lookupPatSynBndr vars
; return ( (pat', PrefixPatSyn names)
, mkFVs (map unLoc names)) }
InfixPatSyn var1 var2 ->
do { checkDupRdrNames [var1, var2]
; name1 <- lookupVar var1
; name2 <- lookupVar var2
; name1 <- lookupPatSynBndr var1
; name2 <- lookupPatSynBndr var2
-- ; checkPrecMatch -- TODO
; return ( (pat', InfixPatSyn name1 name2)
, mkFVs (map unLoc [name1, name2])) }
......@@ -651,7 +651,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
(RecordPatSynField { recordPatSynSelectorId = visible
, recordPatSynPatVar = hidden })
= do { visible' <- lookupLocatedTopBndrRn visible
; hidden' <- lookupVar hidden
; hidden' <- lookupPatSynBndr hidden
; return $ RecordPatSynField { recordPatSynSelectorId = visible'
, recordPatSynPatVar = hidden' } }
; names <- mapM rnRecordPatSynField vars
......@@ -688,7 +688,8 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
-- Why fvs1? See Note [Pattern synonym builders don't yield dependencies]
}
where
lookupVar = wrapLocM lookupOccRn
-- See Note [Renaming pattern synonym variables]
lookupPatSynBndr = wrapLocM lookupLocalOccRn
patternSynonymErr :: SDoc
patternSynonymErr
......@@ -696,6 +697,36 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
2 (text "Use -XPatternSynonyms to enable this extension")
{-
Note [Renaming pattern synonym variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We rename pattern synonym declaractions backwards to normal to reuse
the logic already implemented for renaming patterns.
We first rename the RHS of a declaration which brings into
scope the variables bound by the pattern (as they would be
in normal function definitions). We then lookup the variables
which we want to bind in this local environment.
It is crucial that we then only lookup in the *local* environment which
only contains the variables brought into scope by the pattern and nothing
else. Amazingly no-one encountered this bug for 3 GHC versions but
it was possible to define a pattern synonym which referenced global
identifiers and worked correctly.
```
x = 5
pattern P :: Int -> ()
pattern P x <- _
f (P x) = x
> f () = 5
```
See #13470 for the original report.
Note [Pattern synonym builders don't yield dependencies]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When renaming a pattern synonym that has an explicit builder,
......
......@@ -11,7 +11,7 @@ module RnEnv (
lookupLocatedTopBndrRn, lookupTopBndrRn,
lookupLocatedOccRn, lookupOccRn, lookupOccRn_maybe,
lookupLocalOccRn_maybe, lookupInfoOccRn,
lookupLocalOccThLvl_maybe,
lookupLocalOccThLvl_maybe, lookupLocalOccRn,
lookupTypeOccRn, lookupKindOccRn,
lookupGlobalOccRn, lookupGlobalOccRn_maybe,
lookupOccRn_overloaded, lookupGlobalOccRn_overloaded, lookupExactOcc,
......@@ -691,6 +691,15 @@ lookupOccRn rdr_name
Just name -> return name
Nothing -> reportUnboundName rdr_name }
-- Only used in one place, to rename pattern synonym binders.
-- See Note [Renaming pattern synonym variables] in RnBinds
lookupLocalOccRn :: RdrName -> RnM Name
lookupLocalOccRn rdr_name
= do { mb_name <- lookupLocalOccRn_maybe rdr_name
; case mb_name of
Just name -> return name
Nothing -> unboundName WL_LocalOnly rdr_name }
lookupKindOccRn :: RdrName -> RnM Name
-- Looking up a name occurring in a kind
lookupKindOccRn rdr_name
......@@ -1795,6 +1804,10 @@ checkShadowedOccs (global_env,local_env) get_loc_occ ns
data WhereLooking = WL_Any -- Any binding
| WL_Global -- Any top-level binding (local or imported)
| WL_LocalTop -- Any top-level binding in this module
| WL_LocalOnly
-- Only local bindings
-- (pattern synonyms declaractions,
-- see Note [Renaming pattern synonym variables])
reportUnboundName :: RdrName -> RnM Name
reportUnboundName rdr = unboundName WL_Any rdr
......@@ -1843,7 +1856,7 @@ unknownNameSuggestions_ :: WhereLooking -> DynFlags
-> RdrName -> SDoc
unknownNameSuggestions_ where_look dflags global_env local_env imports tried_rdr_name =
similarNameSuggestions where_look dflags global_env local_env tried_rdr_name $$
importSuggestions imports tried_rdr_name
importSuggestions where_look imports tried_rdr_name
similarNameSuggestions :: WhereLooking -> DynFlags
......@@ -1890,7 +1903,9 @@ similarNameSuggestions where_look dflags global_env
-- This heuristic avoids things like
-- Not in scope 'f'; perhaps you meant '+' (from Prelude)
local_ok = case where_look of { WL_Any -> True; _ -> False }
local_ok = case where_look of { WL_Any -> True
; WL_LocalOnly -> True
; _ -> False }
local_possibilities :: LocalRdrEnv -> [(RdrName, SrcSpan)]
local_possibilities env
| tried_is_qual = []
......@@ -1902,8 +1917,9 @@ similarNameSuggestions where_look dflags global_env
gre_ok :: GlobalRdrElt -> Bool
gre_ok = case where_look of
WL_LocalTop -> isLocalGRE
_ -> \_ -> True
WL_LocalTop -> isLocalGRE
WL_LocalOnly -> const False
_ -> const True
global_possibilities :: GlobalRdrEnv -> [(RdrName, (RdrName, HowInScope))]
global_possibilities global_env
......@@ -1964,8 +1980,9 @@ similarNameSuggestions where_look dflags global_env
| i <- is, let ispec = is_decl i, is_qual ispec ]
-- | Generate helpful suggestions if a qualified name Mod.foo is not in scope.
importSuggestions :: ImportAvails -> RdrName -> SDoc
importSuggestions imports rdr_name
importSuggestions :: WhereLooking -> ImportAvails -> RdrName -> SDoc
importSuggestions where_look imports rdr_name
| WL_LocalOnly <- where_look = Outputable.empty
| not (isQual rdr_name || isUnqual rdr_name) = Outputable.empty
| null interesting_imports
, Just name <- mod_name
......
{-# Language PatternSynonyms #-}
module T13470 where
-- Used to suggest importing not
pattern XInstrProxy :: (Bool -> Bool) -> a
pattern XInstrProxy not <- _
-- Used to suggest 'tan' from another module
pattern P nan <- _
-- Should suggest the inscope similar variable
pattern P1 x12345 <- Just x123456
-- But not this one
x1234567 = True
T13470.hs:7:21: error: Not in scope: ‘not’
T13470.hs:11:11: error: Not in scope: ‘nan’
T13470.hs:16:12: error:
Not in scope: ‘x12345’
Perhaps you meant ‘x123456’ (line 16)
......@@ -35,3 +35,4 @@ test('T12165', normal, compile_fail, [''])
test('T12819', normal, compile_fail, [''])
test('UnliftedPSBind', normal, compile_fail, [''])
test('T13349', normal, compile_fail, [''])
test('T13470', normal, compile_fail, [''])
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