[commit: ghc] master: Revert "Allow as-patterns in pattern synonym declarations." (48e0634)
git at git.haskell.org
git at git.haskell.org
Wed Dec 23 07:46:16 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/48e06346805ab882a54088e01e5224111182f5df/ghc
>---------------------------------------------------------------
commit 48e06346805ab882a54088e01e5224111182f5df
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Mon Dec 21 10:34:41 2015 +0000
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 44640af7afa1a01ff2e2357f7c1436b4804866fc.
>---------------------------------------------------------------
48e06346805ab882a54088e01e5224111182f5df
compiler/hsSyn/HsPat.hs | 32 ----------------------
compiler/typecheck/TcPatSyn.hs | 7 ++---
testsuite/tests/patsyn/should_compile/T9793.hs | 5 ----
testsuite/tests/patsyn/should_compile/all.T | 1 -
testsuite/tests/patsyn/should_fail/T9793-fail.hs | 6 ----
.../tests/patsyn/should_fail/T9793-fail.stderr | 5 ----
testsuite/tests/patsyn/should_fail/all.T | 1 -
.../tests/patsyn/should_fail/as-pattern.stderr | 2 +-
8 files changed, 3 insertions(+), 56 deletions(-)
diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs
index 1751b96..ff1ce1e 100644
--- a/compiler/hsSyn/HsPat.hs
+++ b/compiler/hsSyn/HsPat.hs
@@ -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"
diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs
index d7477ee..5f92250 100644
--- a/compiler/typecheck/TcPatSyn.hs
+++ b/compiler/typecheck/TcPatSyn.hs
@@ -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
diff --git a/testsuite/tests/patsyn/should_compile/T9793.hs b/testsuite/tests/patsyn/should_compile/T9793.hs
deleted file mode 100644
index 230c861..0000000
--- a/testsuite/tests/patsyn/should_compile/T9793.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-{-# LANGUAGE PatternSynonyms #-}
-module T9793 where
-
-pattern P :: [a] -> [a]
-pattern P x <- x@(_:_)
diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T
index 074e129..dd2bbf4 100644
--- a/testsuite/tests/patsyn/should_compile/all.T
+++ b/testsuite/tests/patsyn/should_compile/all.T
@@ -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, [''])
diff --git a/testsuite/tests/patsyn/should_fail/T9793-fail.hs b/testsuite/tests/patsyn/should_fail/T9793-fail.hs
deleted file mode 100644
index 2787a8d..0000000
--- a/testsuite/tests/patsyn/should_fail/T9793-fail.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-{-# LANGUAGE PatternSynonyms #-}
-
-module Foo where
-
-pattern P :: [a] -> [a]
-pattern P x <- x@(y:_)
diff --git a/testsuite/tests/patsyn/should_fail/T9793-fail.stderr b/testsuite/tests/patsyn/should_fail/T9793-fail.stderr
deleted file mode 100644
index 23122f9..0000000
--- a/testsuite/tests/patsyn/should_fail/T9793-fail.stderr
+++ /dev/null
@@ -1,5 +0,0 @@
-
-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’
diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T
index 6163da1..6ef64ae 100644
--- a/testsuite/tests/patsyn/should_fail/all.T
+++ b/testsuite/tests/patsyn/should_fail/all.T
@@ -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, [''])
diff --git a/testsuite/tests/patsyn/should_fail/as-pattern.stderr b/testsuite/tests/patsyn/should_fail/as-pattern.stderr
index 00ea6c8..61df617 100644
--- a/testsuite/tests/patsyn/should_fail/as-pattern.stderr
+++ b/testsuite/tests/patsyn/should_fail/as-pattern.stderr
@@ -1,5 +1,5 @@
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’
More information about the ghc-commits
mailing list