Allow as-patterns in pattern synonym declarations.

We can allow them if they contain no free variables. This patch just allows
them in one direction and not to be used as builders as the original ticket
suggests.

Test Plan: ./validate

Reviewers: austin, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1666

GHC Trac Issues:  #9739

Conflicts:
	testsuite/tests/patsyn/should_fail/all.T

1 files changed, 32 insertions, 0 deletions

diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs
index 0f65e4b297..38f06264a2 100644
--- a/compiler/hsSyn/HsPat.hs
+++ b/compiler/hsSyn/HsPat.hs
@@ -34,6 +34,8 @@ module HsPat (
 
         collectEvVarsPats,
 
+        hasFreeVarsLPat, hasFreeVarsPat,
+
         pprParendLPat, pprConArgs
     ) where
 
@@ -656,3 +658,33 @@ 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"