Commit 48e06346 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Revert "Allow as-patterns in pattern synonym declarations."

I'm reverting this until we agree a design.
See comment:5 in Trac #9793.

Incidentally the reference to Trac #9739 in the reverted
patch is bogus; it shold have said #9793.

This reverts commit 44640af7.
parent 5f086816
......@@ -33,8 +33,6 @@ module HsPat (
collectEvVarsPats,
hasFreeVarsLPat, hasFreeVarsPat,
pprParendLPat, pprConArgs
) where
......@@ -641,33 +639,3 @@ collectEvVarsPat pat =
ConPatIn _ _ -> panic "foldMapPatBag: ConPatIn"
SigPatIn _ _ -> panic "foldMapPatBag: SigPatIn"
_other_pat -> emptyBag
hasFreeVarsLPat :: LPat id -> Bool
hasFreeVarsLPat (L _ pat) = hasFreeVarsPat pat
-- | Checks whether a pattern contains any unbound variables from
-- `VarPat`s or `AsPat`s.
hasFreeVarsPat :: Pat id -> Bool
hasFreeVarsPat pat =
case pat of
VarPat {} -> True
AsPat {} -> True
NPlusKPat {} -> True
NPat {} -> False
LitPat {} -> False
WildPat {} -> False
ViewPat _ p _ -> hasFreeVarsLPat p
LazyPat p -> hasFreeVarsLPat p
ParPat p -> hasFreeVarsLPat p
BangPat p -> hasFreeVarsLPat p
ListPat ps _ _ -> any hasFreeVarsLPat ps
TuplePat ps _ _ -> any hasFreeVarsLPat ps
PArrPat ps _ -> any hasFreeVarsLPat ps
ConPatOut {pat_args = ps}
-> any hasFreeVarsLPat (hsConPatArgs ps)
SigPatOut p _ -> hasFreeVarsLPat p
CoPat _ p _ -> hasFreeVarsPat p
ConPatIn _ p -> any hasFreeVarsLPat (hsConPatArgs p)
SigPatIn p _ -> hasFreeVarsLPat p
SplicePat {} -> panic "hasFreVarsPat: SplicePat"
......@@ -721,10 +721,7 @@ tcCheckPatSynPat = go
go1 (ConPatIn _ info) = mapM_ go (hsConPatArgs info)
go1 VarPat{} = return ()
go1 WildPat{} = return ()
go1 pat@(AsPat _ p) =
if hasFreeVarsLPat p
then asPatInPatSynErr pat
else go p
go1 p@(AsPat _ _) = asPatInPatSynErr p
go1 (LazyPat pat) = go pat
go1 (ParPat pat) = go pat
go1 (BangPat pat) = go pat
......@@ -744,7 +741,7 @@ tcCheckPatSynPat = go
asPatInPatSynErr :: OutputableBndr name => Pat name -> TcM a
asPatInPatSynErr pat
= failWithTc $
hang (ptext (sLit "Pattern synonym definition cannot contain as-patterns (@) which contain free variables:"))
hang (ptext (sLit "Pattern synonym definition cannot contain as-patterns (@):"))
2 (ppr pat)
thInPatSynErr :: OutputableBndr name => Pat name -> TcM a
......
{-# LANGUAGE PatternSynonyms #-}
module T9793 where
pattern P :: [a] -> [a]
pattern P x <- x@(_:_)
......@@ -44,6 +44,5 @@ test('export-record-selector', normal, compile, [''])
test('T10897', expect_broken(10897), multi_compile, ['T10897', [
('T10897a.hs','-c')
,('T10897b.hs', '-c')], ''])
test('T9793', normal, compile, [''])
test('T11224b', normal, compile, [''])
test('MoreEx', normal, compile, [''])
{-# LANGUAGE PatternSynonyms #-}
module Foo where
pattern P :: [a] -> [a]
pattern P x <- x@(y:_)
T9793-fail.hs:6:16: error:
• Pattern synonym definition cannot contain as-patterns (@) which contain free variables:
x@(y : _)
• In the declaration for pattern synonym ‘P’
......@@ -27,4 +27,3 @@ test('export-type-synonym', normal, compile_fail, [''])
test('export-ps-rec-sel', normal, compile_fail, [''])
test('T11053', normal, compile, ['-fwarn-missing-pat-syn-sigs'])
test('T10426', normal, compile_fail, [''])
test('T9793-fail', normal, compile_fail, [''])
as-pattern.hs:4:18: error:
• Pattern synonym definition cannot contain as-patterns (@) which contain free variables:
• Pattern synonym definition cannot contain as-patterns (@):
x@(Just y)
• In the declaration for pattern synonym ‘P’
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