Commit e0a55415 authored by cactus's avatar cactus

Issue an error for pattern synonyms defined in a local scope (#8757)

This also fixes the internal crash when using pattern synonyms
in GHCi (#8749)
parent 674c969c
...@@ -434,9 +434,16 @@ rnBindLHS name_maker _ bind@(FunBind { fun_id = name@(L nameLoc _) }) ...@@ -434,9 +434,16 @@ rnBindLHS name_maker _ bind@(FunBind { fun_id = name@(L nameLoc _) })
; return (bind { fun_id = L nameLoc newname }) } ; return (bind { fun_id = L nameLoc newname }) }
rnBindLHS name_maker _ bind@(PatSynBind{ patsyn_id = rdrname@(L nameLoc _) }) rnBindLHS name_maker _ bind@(PatSynBind{ patsyn_id = rdrname@(L nameLoc _) })
= do { addLocM checkConName rdrname = do { unless (isTopRecNameMaker name_maker) $
addErr localPatternSynonymErr
; addLocM checkConName rdrname
; name <- applyNameMaker name_maker rdrname ; name <- applyNameMaker name_maker rdrname
; return (bind{ patsyn_id = L nameLoc name }) } ; return (bind{ patsyn_id = L nameLoc name }) }
where
localPatternSynonymErr :: SDoc
localPatternSynonymErr
= hang (ptext (sLit "Illegal pattern synonym declaration"))
2 (ptext (sLit "Pattern synonym declarations are only valid in the top-level scope"))
rnBindLHS _ _ b = pprPanic "rnBindHS" (ppr b) rnBindLHS _ _ b = pprPanic "rnBindHS" (ppr b)
......
...@@ -23,6 +23,7 @@ module RnPat (-- main entry points ...@@ -23,6 +23,7 @@ module RnPat (-- main entry points
NameMaker, applyNameMaker, -- a utility for making names: NameMaker, applyNameMaker, -- a utility for making names:
localRecNameMaker, topRecNameMaker, -- sometimes we want to make local names, localRecNameMaker, topRecNameMaker, -- sometimes we want to make local names,
-- sometimes we want to make top (qualified) names. -- sometimes we want to make top (qualified) names.
isTopRecNameMaker,
rnHsRecFields1, HsRecFieldContext(..), rnHsRecFields1, HsRecFieldContext(..),
...@@ -193,6 +194,10 @@ data NameMaker ...@@ -193,6 +194,10 @@ data NameMaker
topRecNameMaker :: MiniFixityEnv -> NameMaker topRecNameMaker :: MiniFixityEnv -> NameMaker
topRecNameMaker fix_env = LetMk TopLevel fix_env topRecNameMaker fix_env = LetMk TopLevel fix_env
isTopRecNameMaker :: NameMaker -> Bool
isTopRecNameMaker (LetMk TopLevel _) = True
isTopRecNameMaker _ = False
localRecNameMaker :: MiniFixityEnv -> NameMaker localRecNameMaker :: MiniFixityEnv -> NameMaker
localRecNameMaker fix_env = LetMk NotTopLevel fix_env localRecNameMaker fix_env = LetMk NotTopLevel fix_env
......
test('mono', normal, compile_fail, ['']) test('mono', normal, compile_fail, [''])
test('unidir', normal, compile_fail, ['']) test('unidir', normal, compile_fail, [''])
test('local', 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