Pattern/expression ambiguity resolution
authorVladislav Zavialov <vlad.z.4096@gmail.com>
Tue, 23 Apr 2019 18:21:33 +0000 (21:21 +0300)
committerÖmer Sinan Ağacan <omeragacan@gmail.com>
Fri, 3 May 2019 18:54:50 +0000 (21:54 +0300)
This patch removes 'EWildPat', 'EAsPat', 'EViewPat', and 'ELazyPat'
from 'HsExpr' by using the ambiguity resolution system introduced
earlier for the command/expression ambiguity.

Problem: there are places in the grammar where we do not know whether we
are parsing an expression or a pattern, for example:

do { Con a b <- x } -- 'Con a b' is a pattern
do { Con a b }      -- 'Con a b' is an expression

Until we encounter binding syntax (<-) we don't know whether to parse
'Con a b' as an expression or a pattern.

The old solution was to parse as HsExpr always, and rejig later:

checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs)

This meant polluting 'HsExpr' with pattern-related constructors. In
other words, limitations of the parser were affecting the AST, and all
other code (the renamer, the typechecker) had to deal with these extra
constructors.

We fix this abstraction leak by parsing into an overloaded
representation:

class DisambECP b where ...
newtype ECP = ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) }

See Note [Ambiguous syntactic categories] for details.

Now the intricacies of parsing have no effect on the hsSyn AST when it
comes to the expression/pattern ambiguity.

48 files changed:
compiler/deSugar/DsExpr.hs
compiler/hieFile/HieAst.hs
compiler/hsSyn/HsExpr.hs
compiler/hsSyn/HsExtension.hs
compiler/parser/Lexer.x
compiler/parser/Parser.y
compiler/parser/RdrHsSyn.hs
compiler/rename/RnExpr.hs
compiler/typecheck/TcRnTypes.hs
testsuite/tests/parser/should_fail/InfixAppPatErr.stderr
testsuite/tests/parser/should_fail/T984.stderr
testsuite/tests/parser/should_fail/all.T
testsuite/tests/parser/should_fail/cmdFail001.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail001.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail002.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail002.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail003.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail003.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail004.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail004.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail005.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail005.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail006.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail006.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail007.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail007.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail008.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail008.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail009.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/cmdFail009.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail001.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail001.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail002.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail002.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail003.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail003.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail004.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail004.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail005.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail005.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail006.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail006.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail007.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail007.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail008.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail008.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail009.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/patFail009.stderr [new file with mode: 0644]

index 89ca815..12b0c83 100644 (file)
@@ -752,10 +752,6 @@ ds_expr _ (HsTickPragma _ _ _ _ expr) = do
 
 -- HsSyn constructs that just shouldn't be here:
 ds_expr _ (HsBracket     {})  = panic "dsExpr:HsBracket"
 
 -- HsSyn constructs that just shouldn't be here:
 ds_expr _ (HsBracket     {})  = panic "dsExpr:HsBracket"
-ds_expr _ (EWildPat      {})  = panic "dsExpr:EWildPat"
-ds_expr _ (EAsPat        {})  = panic "dsExpr:EAsPat"
-ds_expr _ (EViewPat      {})  = panic "dsExpr:EViewPat"
-ds_expr _ (ELazyPat      {})  = panic "dsExpr:ELazyPat"
 ds_expr _ (HsDo          {})  = panic "dsExpr:HsDo"
 ds_expr _ (HsRecFld      {})  = panic "dsExpr:HsRecFld"
 ds_expr _ (XExpr         {})  = panic "dsExpr: XExpr"
 ds_expr _ (HsDo          {})  = panic "dsExpr:HsDo"
 ds_expr _ (HsRecFld      {})  = panic "dsExpr:HsRecFld"
 ds_expr _ (XExpr         {})  = panic "dsExpr: XExpr"
index 2ab2acb..d86077e 100644 (file)
@@ -870,18 +870,6 @@ instance ( a ~ GhcPass p
       HsSpliceE _ x ->
         [ toHie $ L mspan x
         ]
       HsSpliceE _ x ->
         [ toHie $ L mspan x
         ]
-      EWildPat _ -> []
-      EAsPat _ a b ->
-        [ toHie $ C Use a
-        , toHie b
-        ]
-      EViewPat _ a b ->
-        [ toHie a
-        , toHie b
-        ]
-      ELazyPat _ a ->
-        [ toHie a
-        ]
       XExpr _ -> []
 
 instance ( a ~ GhcPass p
       XExpr _ -> []
 
 instance ( a ~ GhcPass p
index b86f4a1..9052855 100644 (file)
@@ -625,32 +625,6 @@ data HsExpr p
      (LHsExpr p)
 
   ---------------------------------------
      (LHsExpr p)
 
   ---------------------------------------
-  -- These constructors only appear temporarily in the parser.
-  -- The renamer translates them into the Right Thing.
-
-  | EWildPat (XEWildPat p)        -- wildcard
-
-  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
-
-  -- For details on above see note [Api annotations] in ApiAnnotation
-  | EAsPat      (XEAsPat p)
-                (Located (IdP p)) -- as pattern
-                (LHsExpr p)
-
-  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
-
-  -- For details on above see note [Api annotations] in ApiAnnotation
-  | EViewPat    (XEViewPat p)
-                (LHsExpr p) -- view pattern
-                (LHsExpr p)
-
-  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
-
-  -- For details on above see note [Api annotations] in ApiAnnotation
-  | ELazyPat    (XELazyPat p) (LHsExpr p) -- ~ pattern
-
-
-  ---------------------------------------
   -- Finally, HsWrap appears only in typechecker output
   -- The contained Expr is *NOT* itself an HsWrap.
   -- See Note [Detecting forced eta expansion] in DsExpr. This invariant
   -- Finally, HsWrap appears only in typechecker output
   -- The contained Expr is *NOT* itself an HsWrap.
   -- See Note [Detecting forced eta expansion] in DsExpr. This invariant
@@ -761,10 +735,6 @@ type instance XStatic        GhcTc = NameSet
 type instance XTick          (GhcPass _) = NoExt
 type instance XBinTick       (GhcPass _) = NoExt
 type instance XTickPragma    (GhcPass _) = NoExt
 type instance XTick          (GhcPass _) = NoExt
 type instance XBinTick       (GhcPass _) = NoExt
 type instance XTickPragma    (GhcPass _) = NoExt
-type instance XEWildPat      (GhcPass _) = NoExt
-type instance XEAsPat        (GhcPass _) = NoExt
-type instance XEViewPat      (GhcPass _) = NoExt
-type instance XELazyPat      (GhcPass _) = NoExt
 type instance XWrap          (GhcPass _) = NoExt
 type instance XXExpr         (GhcPass _) = NoExt
 
 type instance XWrap          (GhcPass _) = NoExt
 type instance XXExpr         (GhcPass _) = NoExt
 
@@ -924,21 +894,12 @@ ppr_expr e@(HsApp {})        = ppr_apps e []
 ppr_expr e@(HsAppType {})    = ppr_apps e []
 
 ppr_expr (OpApp _ e1 op e2)
 ppr_expr e@(HsAppType {})    = ppr_apps e []
 
 ppr_expr (OpApp _ e1 op e2)
-  | Just pp_op <- should_print_infix (unLoc op)
+  | Just pp_op <- ppr_infix_expr (unLoc op)
   = pp_infixly pp_op
   | otherwise
   = pp_prefixly
 
   where
   = pp_infixly pp_op
   | otherwise
   = pp_prefixly
 
   where
-    should_print_infix (HsVar _ (L _ v)) = Just (pprInfixOcc v)
-    should_print_infix (HsConLikeOut _ c)= Just (pprInfixOcc (conLikeName c))
-    should_print_infix (HsRecFld _ f)    = Just (pprInfixOcc f)
-    should_print_infix (HsUnboundVar _ h@TrueExprHole{})
-                                       = Just (pprInfixOcc (unboundVarOcc h))
-    should_print_infix (EWildPat _)    = Just (text "`_`")
-    should_print_infix (HsWrap _ _ e)  = should_print_infix e
-    should_print_infix _               = Nothing
-
     pp_e1 = pprDebugParendExpr opPrec e1   -- In debug mode, add parens
     pp_e2 = pprDebugParendExpr opPrec e2   -- to make precedence clear
 
     pp_e1 = pprDebugParendExpr opPrec e1   -- In debug mode, add parens
     pp_e2 = pprDebugParendExpr opPrec e2   -- to make precedence clear
 
@@ -951,36 +912,30 @@ ppr_expr (OpApp _ e1 op e2)
 ppr_expr (NegApp _ e _) = char '-' <+> pprDebugParendExpr appPrec e
 
 ppr_expr (SectionL _ expr op)
 ppr_expr (NegApp _ e _) = char '-' <+> pprDebugParendExpr appPrec e
 
 ppr_expr (SectionL _ expr op)
-  = case unLoc op of
-      HsVar _ (L _ v)  -> pp_infixly v
-      HsConLikeOut _ c -> pp_infixly (conLikeName c)
-      HsUnboundVar _ h@TrueExprHole{}
-                       -> pp_infixly (unboundVarOcc h)
-      _                -> pp_prefixly
+  | Just pp_op <- ppr_infix_expr (unLoc op)
+  = pp_infixly pp_op
+  | otherwise
+  = pp_prefixly
   where
     pp_expr = pprDebugParendExpr opPrec expr
 
     pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
                        4 (hsep [pp_expr, text "x_ )"])
 
   where
     pp_expr = pprDebugParendExpr opPrec expr
 
     pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
                        4 (hsep [pp_expr, text "x_ )"])
 
-    pp_infixly :: forall a. (OutputableBndr a) => a -> SDoc
-    pp_infixly v = (sep [pp_expr, pprInfixOcc v])
+    pp_infixly v = (sep [pp_expr, v])
 
 ppr_expr (SectionR _ op expr)
 
 ppr_expr (SectionR _ op expr)
-  = case unLoc op of
-      HsVar _ (L _ v)  -> pp_infixly v
-      HsConLikeOut _ c -> pp_infixly (conLikeName c)
-      HsUnboundVar _ h@TrueExprHole{}
-                       -> pp_infixly (unboundVarOcc h)
-      _                -> pp_prefixly
+  | Just pp_op <- ppr_infix_expr (unLoc op)
+  = pp_infixly pp_op
+  | otherwise
+  = pp_prefixly
   where
     pp_expr = pprDebugParendExpr opPrec expr
 
     pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, text "x_"])
                        4 (pp_expr <> rparen)
 
   where
     pp_expr = pprDebugParendExpr opPrec expr
 
     pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, text "x_"])
                        4 (pp_expr <> rparen)
 
-    pp_infixly :: forall a. (OutputableBndr a) => a -> SDoc
-    pp_infixly v = sep [pprInfixOcc v, pp_expr]
+    pp_infixly v = sep [v, pp_expr]
 
 ppr_expr (ExplicitTuple _ exprs boxity)
   = tupleParens (boxityTupleSort boxity) (fcat (ppr_tup_args $ map unLoc exprs))
 
 ppr_expr (ExplicitTuple _ exprs boxity)
   = tupleParens (boxityTupleSort boxity) (fcat (ppr_tup_args $ map unLoc exprs))
@@ -1057,11 +1012,6 @@ ppr_expr (ExprWithTySig _ expr sig)
 
 ppr_expr (ArithSeq _ _ info) = brackets (ppr info)
 
 
 ppr_expr (ArithSeq _ _ info) = brackets (ppr info)
 
-ppr_expr (EWildPat _)     = char '_'
-ppr_expr (ELazyPat _ e)   = char '~' <> ppr e
-ppr_expr (EAsPat _ (L _ v) e) = pprPrefixOcc v <> char '@' <> ppr e
-ppr_expr (EViewPat _ p e) = ppr p <+> text "->" <+> ppr e
-
 ppr_expr (HsSCC _ st (StringLiteral stl lbl) expr)
   = sep [ pprWithSourceText st (text "{-# SCC")
          -- no doublequotes if stl empty, for the case where the SCC was written
 ppr_expr (HsSCC _ st (StringLiteral stl lbl) expr)
   = sep [ pprWithSourceText st (text "{-# SCC")
          -- no doublequotes if stl empty, for the case where the SCC was written
@@ -1110,6 +1060,14 @@ ppr_expr (HsTickPragma _ _ externalSrcLoc _ exp)
 ppr_expr (HsRecFld _ f) = ppr f
 ppr_expr (XExpr x) = ppr x
 
 ppr_expr (HsRecFld _ f) = ppr f
 ppr_expr (XExpr x) = ppr x
 
+ppr_infix_expr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> Maybe SDoc
+ppr_infix_expr (HsVar _ (L _ v)) = Just (pprInfixOcc v)
+ppr_infix_expr (HsConLikeOut _ c)= Just (pprInfixOcc (conLikeName c))
+ppr_infix_expr (HsRecFld _ f)    = Just (pprInfixOcc f)
+ppr_infix_expr (HsUnboundVar _ h@TrueExprHole{}) = Just (pprInfixOcc (unboundVarOcc h))
+ppr_infix_expr (HsWrap _ _ e)    = ppr_infix_expr e
+ppr_infix_expr _                 = Nothing
+
 ppr_apps :: (OutputableBndrId (GhcPass p))
          => HsExpr (GhcPass p)
          -> [Either (LHsExpr (GhcPass p)) (LHsWcType (NoGhcTc (GhcPass p)))]
 ppr_apps :: (OutputableBndrId (GhcPass p))
          => HsExpr (GhcPass p)
          -> [Either (LHsExpr (GhcPass p)) (LHsWcType (NoGhcTc (GhcPass p)))]
@@ -1196,10 +1154,6 @@ hsExprNeedsParens p = go
     go (RecordUpd{})                  = False
     go (ExprWithTySig{})              = p >= sigPrec
     go (ArithSeq{})                   = False
     go (RecordUpd{})                  = False
     go (ExprWithTySig{})              = p >= sigPrec
     go (ArithSeq{})                   = False
-    go (EWildPat{})                   = False
-    go (ELazyPat{})                   = False
-    go (EAsPat{})                     = False
-    go (EViewPat{})                   = True
     go (HsSCC{})                      = p >= appPrec
     go (HsWrap _ _ e)                 = go e
     go (HsSpliceE{})                  = False
     go (HsSCC{})                      = p >= appPrec
     go (HsWrap _ _ e)                 = go e
     go (HsSpliceE{})                  = False
index 1bebec0..1d14da2 100644 (file)
@@ -539,10 +539,6 @@ type family XStatic         x
 type family XTick           x
 type family XBinTick        x
 type family XTickPragma     x
 type family XTick           x
 type family XBinTick        x
 type family XTickPragma     x
-type family XEWildPat       x
-type family XEAsPat         x
-type family XEViewPat       x
-type family XELazyPat       x
 type family XWrap           x
 type family XXExpr          x
 
 type family XWrap           x
 type family XXExpr          x
 
@@ -587,10 +583,6 @@ type ForallXExpr (c :: * -> Constraint) (x :: *) =
        , c (XTick           x)
        , c (XBinTick        x)
        , c (XTickPragma     x)
        , c (XTick           x)
        , c (XBinTick        x)
        , c (XTickPragma     x)
-       , c (XEWildPat       x)
-       , c (XEAsPat         x)
-       , c (XEViewPat       x)
-       , c (XELazyPat       x)
        , c (XWrap           x)
        , c (XXExpr          x)
        )
        , c (XWrap           x)
        , c (XXExpr          x)
        )
index c23c320..3c1ea8c 100644 (file)
@@ -58,7 +58,6 @@ module Lexer (
    activeContext, nextIsEOF,
    getLexState, popLexState, pushLexState,
    ExtBits(..),
    activeContext, nextIsEOF,
    getLexState, popLexState, pushLexState,
    ExtBits(..),
-   addWarning,
    lexTokenStream,
    AddAnn,mkParensApiAnn,
    commentToAnnotation
    lexTokenStream,
    AddAnn,mkParensApiAnn,
    commentToAnnotation
@@ -2493,6 +2492,9 @@ class Monad m => MonadP m where
   --   more than one parse error per file.
   --
   addError :: SrcSpan -> SDoc -> m ()
   --   more than one parse error per file.
   --
   addError :: SrcSpan -> SDoc -> m ()
+  -- | Add a warning to the accumulator.
+  --   Use 'getMessages' to get the accumulated warnings.
+  addWarning :: WarningFlag -> SrcSpan -> SDoc -> m ()
   -- | Add a fatal error. This will be the last error reported by the parser, and
   --   the parser will not produce any result, ending in a 'PFailed' state.
   addFatalError :: SrcSpan -> SDoc -> m a
   -- | Add a fatal error. This will be the last error reported by the parser, and
   --   the parser will not produce any result, ending in a 'PFailed' state.
   addFatalError :: SrcSpan -> SDoc -> m a
@@ -2515,6 +2517,16 @@ instance MonadP P where
                      es' = es `snocBag` errormsg
                  in (ws, es')
          in POk s{messages=m'} ()
                      es' = es `snocBag` errormsg
                  in (ws, es')
          in POk s{messages=m'} ()
+  addWarning option srcspan warning
+   = P $ \s@PState{messages=m, options=o} ->
+         let
+             m' d =
+                 let (ws, es) = m d
+                     warning' = makeIntoWarning (Reason option) $
+                        mkWarnMsg d srcspan alwaysQualify warning
+                     ws' = if warnopt option o then ws `snocBag` warning' else ws
+                 in (ws', es)
+         in POk s{messages=m'} ()
   addFatalError span msg =
     addError span msg >> P PFailed
   getBit ext = P $ \s -> let b =  ext `xtest` pExtsBitmap (options s)
   addFatalError span msg =
     addError span msg >> P PFailed
   getBit ext = P $ \s -> let b =  ext `xtest` pExtsBitmap (options s)
@@ -2524,20 +2536,6 @@ instance MonadP P where
     addAnnotationOnly l a v
     allocateComments l
 
     addAnnotationOnly l a v
     allocateComments l
 
--- | Add a warning to the accumulator.
---   Use 'getMessages' to get the accumulated warnings.
-addWarning :: WarningFlag -> SrcSpan -> SDoc -> P ()
-addWarning option srcspan warning
- = P $ \s@PState{messages=m, options=o} ->
-       let
-           m' d =
-               let (ws, es) = m d
-                   warning' = makeIntoWarning (Reason option) $
-                      mkWarnMsg d srcspan alwaysQualify warning
-                   ws' = if warnopt option o then ws `snocBag` warning' else ws
-               in (ws', es)
-       in POk s{messages=m'} ()
-
 addTabWarning :: RealSrcSpan -> P ()
 addTabWarning srcspan
  = P $ \s@PState{tab_first=tf, tab_count=tc, options=o} ->
 addTabWarning :: RealSrcSpan -> P ()
 addTabWarning srcspan
  = P $ \s@PState{tab_first=tf, tab_count=tc, options=o} ->
index 4bc3fa9..80e197e 100644 (file)
@@ -1064,7 +1064,8 @@ topdecl :: { LHsDecl GhcPs }
         -- The $(..) form is one possible form of infixexp
         -- but we treat an arbitrary expression just as if
         -- it had a $(..) wrapped around it
         -- The $(..) form is one possible form of infixexp
         -- but we treat an arbitrary expression just as if
         -- it had a $(..) wrapped around it
-        | infixexp_top                          { sLL $1 $> $ mkSpliceDecl $1 }
+        | infixexp_top                          {% runECP_P $1 >>= \ $1 ->
+                                                   return $ sLL $1 $> $ mkSpliceDecl $1 }
 
 -- Type classes
 --
 
 -- Type classes
 --
@@ -1509,7 +1510,7 @@ decl_cls  : at_decl_cls                 { $1 }
 
           -- A 'default' signature used with the generic-programming extension
           | 'default' infixexp '::' sigtypedoc
 
           -- A 'default' signature used with the generic-programming extension
           | 'default' infixexp '::' sigtypedoc
-                    {% runExpCmdP $2 >>= \ $2 ->
+                    {% runECP_P $2 >>= \ $2 ->
                        do { v <- checkValSigLhs $2
                           ; let err = text "in default signature" <> colon <+>
                                       quotes (ppr $2)
                        do { v <- checkValSigLhs $2
                           ; let err = text "in default signature" <> colon <+>
                                       quotes (ppr $2)
@@ -1649,8 +1650,8 @@ rules   :: { OrdList (LRuleDecl GhcPs) }
 
 rule    :: { LRuleDecl GhcPs }
         : STRING rule_activation rule_foralls infixexp '=' exp
 
 rule    :: { LRuleDecl GhcPs }
         : STRING rule_activation rule_foralls infixexp '=' exp
-         {%runExpCmdP $4 >>= \ $4 ->
-           runExpCmdP $6 >>= \ $6 ->
+         {%runECP_P $4 >>= \ $4 ->
+           runECP_P $6 >>= \ $6 ->
            ams (sLL $1 $> $ HsRule { rd_ext = noExt
                                    , rd_name = cL (gl $1) (getSTRINGs $1, getSTRING $1)
                                    , rd_act = (snd $2) `orElse` AlwaysActive
            ams (sLL $1 $> $ HsRule { rd_ext = noExt
                                    , rd_name = cL (gl $1) (getSTRINGs $1, getSTRING $1)
                                    , rd_act = (snd $2) `orElse` AlwaysActive
@@ -1760,19 +1761,19 @@ stringlist :: { Located (OrdList (Located StringLiteral)) }
 -----------------------------------------------------------------------------
 -- Annotations
 annotation :: { LHsDecl GhcPs }
 -----------------------------------------------------------------------------
 -- Annotations
 annotation :: { LHsDecl GhcPs }
-    : '{-# ANN' name_var aexp '#-}'      {% runExpCmdP $3 >>= \ $3 ->
+    : '{-# ANN' name_var aexp '#-}'      {% runECP_P $3 >>= \ $3 ->
                                             ams (sLL $1 $> (AnnD noExt $ HsAnnotation noExt
                                             (getANN_PRAGs $1)
                                             (ValueAnnProvenance $2) $3))
                                             [mo $1,mc $4] }
 
                                             ams (sLL $1 $> (AnnD noExt $ HsAnnotation noExt
                                             (getANN_PRAGs $1)
                                             (ValueAnnProvenance $2) $3))
                                             [mo $1,mc $4] }
 
-    | '{-# ANN' 'type' tycon aexp '#-}'  {% runExpCmdP $4 >>= \ $4 ->
+    | '{-# ANN' 'type' tycon aexp '#-}'  {% runECP_P $4 >>= \ $4 ->
                                             ams (sLL $1 $> (AnnD noExt $ HsAnnotation noExt
                                             (getANN_PRAGs $1)
                                             (TypeAnnProvenance $3) $4))
                                             [mo $1,mj AnnType $2,mc $5] }
 
                                             ams (sLL $1 $> (AnnD noExt $ HsAnnotation noExt
                                             (getANN_PRAGs $1)
                                             (TypeAnnProvenance $3) $4))
                                             [mo $1,mj AnnType $2,mc $5] }
 
-    | '{-# ANN' 'module' aexp '#-}'      {% runExpCmdP $3 >>= \ $3 ->
+    | '{-# ANN' 'module' aexp '#-}'      {% runECP_P $3 >>= \ $3 ->
                                             ams (sLL $1 $> (AnnD noExt $ HsAnnotation noExt
                                                 (getANN_PRAGs $1)
                                                  ModuleAnnProvenance $3))
                                             ams (sLL $1 $> (AnnD noExt $ HsAnnotation noExt
                                                 (getANN_PRAGs $1)
                                                  ModuleAnnProvenance $3))
@@ -2393,8 +2394,8 @@ docdecld :: { LDocDecl }
 decl_no_th :: { LHsDecl GhcPs }
         : sigdecl               { $1 }
 
 decl_no_th :: { LHsDecl GhcPs }
         : sigdecl               { $1 }
 
-        | '!' aexp rhs          {% runExpCmdP $2 >>= \ $2 ->
-                                   do { let { e = sLL $1 $2 (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)
+        | '!' aexp rhs          {% runECP_P $2 >>= \ $2 ->
+                                   do { let { e = patBuilderBang (getLoc $1) $2
                                             ; l = comb2 $1 $> };
                                         (ann, r) <- checkValDef SrcStrict e Nothing $3 ;
                                         runPV $ hintBangPat (comb2 $1 $2) (unLoc e) ;
                                             ; l = comb2 $1 $> };
                                         (ann, r) <- checkValDef SrcStrict e Nothing $3 ;
                                         runPV $ hintBangPat (comb2 $1 $2) (unLoc e) ;
@@ -2410,7 +2411,8 @@ decl_no_th :: { LHsDecl GhcPs }
                                         _ <- amsL l (ann ++ fst (unLoc $3) ++ [mj AnnBang $1]) ;
                                         return $! (sL l $ ValD noExt r) } }
 
                                         _ <- amsL l (ann ++ fst (unLoc $3) ++ [mj AnnBang $1]) ;
                                         return $! (sL l $ ValD noExt r) } }
 
-        | infixexp_top opt_sig rhs  {% do { (ann,r) <- checkValDef NoSrcStrict $1 (snd $2) $3;
+        | infixexp_top opt_sig rhs  {% runECP_P $1 >>= \ $1 ->
+                                       do { (ann,r) <- checkValDef NoSrcStrict $1 (snd $2) $3;
                                         let { l = comb2 $1 $> };
                                         -- Depending upon what the pattern looks like we might get either
                                         -- a FunBind or PatBind back from checkValDef. See Note
                                         let { l = comb2 $1 $> };
                                         -- Depending upon what the pattern looks like we might get either
                                         -- a FunBind or PatBind back from checkValDef. See Note
@@ -2434,7 +2436,7 @@ decl    :: { LHsDecl GhcPs }
         | splice_exp            { sLL $1 $> $ mkSpliceDecl $1 }
 
 rhs     :: { Located ([AddAnn],GRHSs GhcPs (LHsExpr GhcPs)) }
         | splice_exp            { sLL $1 $> $ mkSpliceDecl $1 }
 
 rhs     :: { Located ([AddAnn],GRHSs GhcPs (LHsExpr GhcPs)) }
-        : '=' exp wherebinds    {% runExpCmdP $2 >>= \ $2 -> return $
+        : '=' exp wherebinds    {% runECP_P $2 >>= \ $2 -> return $
                                   sL (comb3 $1 $2 $3)
                                     ((mj AnnEqual $1 : (fst $ unLoc $3))
                                     ,GRHSs noExt (unguardedRHS (comb3 $1 $2 $3) $2)
                                   sL (comb3 $1 $2 $3)
                                     ((mj AnnEqual $1 : (fst $ unLoc $3))
                                     ,GRHSs noExt (unguardedRHS (comb3 $1 $2 $3) $2)
@@ -2448,7 +2450,7 @@ gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] }
         | gdrh                  { sL1 $1 [$1] }
 
 gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) }
         | gdrh                  { sL1 $1 [$1] }
 
 gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) }
-        : '|' guardquals '=' exp  {% runExpCmdP $4 >>= \ $4 ->
+        : '|' guardquals '=' exp  {% runECP_P $4 >>= \ $4 ->
                                      ams (sL (comb2 $1 $>) $ GRHS noExt (unLoc $2) $4)
                                          [mj AnnVbar $1,mj AnnEqual $3] }
 
                                      ams (sL (comb2 $1 $>) $ GRHS noExt (unLoc $2) $4)
                                          [mj AnnVbar $1,mj AnnEqual $3] }
 
@@ -2456,7 +2458,8 @@ sigdecl :: { LHsDecl GhcPs }
         :
         -- See Note [Declaration/signature overlap] for why we need infixexp here
           infixexp_top '::' sigtypedoc
         :
         -- See Note [Declaration/signature overlap] for why we need infixexp here
           infixexp_top '::' sigtypedoc
-                        {% do { v <- checkValSigLhs $1
+                        {% do { $1 <- runECP_P $1
+                              ; v <- checkValSigLhs $1
                               ; _ <- amsL (comb2 $1 $>) [mu AnnDcolon $2]
                               ; return (sLL $1 $> $ SigD noExt $
                                   TypeSig noExt [v] (mkLHsSigWcType $3))} }
                               ; _ <- amsL (comb2 $1 $>) [mu AnnDcolon $2]
                               ; return (sLL $1 $> $ SigD noExt $
                                   TypeSig noExt [v] (mkLHsSigWcType $3))} }
@@ -2548,84 +2551,90 @@ quasiquote :: { Located (HsSplice GhcPs) }
                                 ; quoterId = mkQual varName (qual, quoter) }
                             in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
 
                                 ; quoterId = mkQual varName (qual, quoter) }
                             in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
 
-exp   :: { ExpCmdP }
-        : infixexp '::' sigtype {% runExpCmdP $1 >>= \ $1 ->
-                                   fmap ecFromExp $
-                                   ams (sLL $1 $> $ ExprWithTySig noExt $1 (mkLHsSigWcType $3))
+exp   :: { ECP }
+        : infixexp '::' sigtype { ECP $
+                                   runECP_PV $1 >>= \ $1 ->
+                                   amms (mkHsTySigPV (comb2 $1 $>) $1 $3)
                                        [mu AnnDcolon $2] }
                                        [mu AnnDcolon $2] }
-        | infixexp '-<' exp     {% runExpCmdP $1 >>= \ $1 ->
-                                   runExpCmdP $3 >>= \ $3 ->
-                                   fmap ecFromCmd $
+        | infixexp '-<' exp     {% runECP_P $1 >>= \ $1 ->
+                                   runECP_P $3 >>= \ $3 ->
+                                   fmap ecpFromCmd $
                                    ams (sLL $1 $> $ HsCmdArrApp noExt $1 $3
                                                         HsFirstOrderApp True)
                                        [mu Annlarrowtail $2] }
                                    ams (sLL $1 $> $ HsCmdArrApp noExt $1 $3
                                                         HsFirstOrderApp True)
                                        [mu Annlarrowtail $2] }
-        | infixexp '>-' exp     {% runExpCmdP $1 >>= \ $1 ->
-                                   runExpCmdP $3 >>= \ $3 ->
-                                   fmap ecFromCmd $
+        | infixexp '>-' exp     {% runECP_P $1 >>= \ $1 ->
+                                   runECP_P $3 >>= \ $3 ->
+                                   fmap ecpFromCmd $
                                    ams (sLL $1 $> $ HsCmdArrApp noExt $3 $1
                                                       HsFirstOrderApp False)
                                        [mu Annrarrowtail $2] }
                                    ams (sLL $1 $> $ HsCmdArrApp noExt $3 $1
                                                       HsFirstOrderApp False)
                                        [mu Annrarrowtail $2] }
-        | infixexp '-<<' exp    {% runExpCmdP $1 >>= \ $1 ->
-                                   runExpCmdP $3 >>= \ $3 ->
-                                   fmap ecFromCmd $
+        | infixexp '-<<' exp    {% runECP_P $1 >>= \ $1 ->
+                                   runECP_P $3 >>= \ $3 ->
+                                   fmap ecpFromCmd $
                                    ams (sLL $1 $> $ HsCmdArrApp noExt $1 $3
                                                       HsHigherOrderApp True)
                                        [mu AnnLarrowtail $2] }
                                    ams (sLL $1 $> $ HsCmdArrApp noExt $1 $3
                                                       HsHigherOrderApp True)
                                        [mu AnnLarrowtail $2] }
-        | infixexp '>>-' exp    {% runExpCmdP $1 >>= \ $1 ->
-                                   runExpCmdP $3 >>= \ $3 ->
-                                   fmap ecFromCmd $
+        | infixexp '>>-' exp    {% runECP_P $1 >>= \ $1 ->
+                                   runECP_P $3 >>= \ $3 ->
+                                   fmap ecpFromCmd $
                                    ams (sLL $1 $> $ HsCmdArrApp noExt $3 $1
                                                       HsHigherOrderApp False)
                                        [mu AnnRarrowtail $2] }
         | infixexp              { $1 }
 
                                    ams (sLL $1 $> $ HsCmdArrApp noExt $3 $1
                                                       HsHigherOrderApp False)
                                        [mu AnnRarrowtail $2] }
         | infixexp              { $1 }
 
-infixexp :: { ExpCmdP }
+infixexp :: { ECP }
         : exp10 { $1 }
         : exp10 { $1 }
-        | infixexp qop exp10  {  ExpCmdP $
-                                 runExpCmdPV $1 >>= \ $1 ->
-                                 runExpCmdPV $3 >>= \ $3 ->
-                                 ams (sLL $1 $> (ecOpApp $1 $2 $3))
+        | infixexp qop exp10  {  ECP $
+                                 superInfixOp $
+                                 $2 >>= \ $2 ->
+                                 runECP_PV $1 >>= \ $1 ->
+                                 runECP_PV $3 >>= \ $3 ->
+                                 amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3)
                                      [mj AnnVal $2] }
                  -- AnnVal annotation for NPlusKPat, which discards the operator
 
                                      [mj AnnVal $2] }
                  -- AnnVal annotation for NPlusKPat, which discards the operator
 
-infixexp_top :: { LHsExpr GhcPs }
-            : exp10_top               {% runExpCmdP $1 }
+infixexp_top :: { ECP }
+            : exp10_top               { $1 }
             | infixexp_top qop exp10_top
             | infixexp_top qop exp10_top
-                                      {% runExpCmdP $3 >>= \ $3 ->
+                                      { ECP $
+                                         superInfixOp $
+                                         $2 >>= \ $2 ->
+                                         runECP_PV $1 >>= \ $1 ->
+                                         runECP_PV $3 >>= \ $3 ->
                                          do { when (srcSpanEnd (getLoc $2)
                                                 == srcSpanStart (getLoc $3)
                                          do { when (srcSpanEnd (getLoc $2)
                                                 == srcSpanStart (getLoc $3)
-                                                && checkIfBang $2) $
+                                                && checkIfBang (unLoc $2)) $
                                                 warnSpaceAfterBang (comb2 $2 $3);
                                                 warnSpaceAfterBang (comb2 $2 $3);
-                                              ams (sLL $1 $> (OpApp noExt $1 $2 $3))
+                                              amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3)
                                                    [mj AnnVal $2]
                                             }
                                       }
 
                                                    [mj AnnVal $2]
                                             }
                                       }
 
-exp10_top :: { ExpCmdP }
-        : '-' fexp                      {% runExpCmdP $2 >>= \ $2 ->
-                                           fmap ecFromExp $
-                                           ams (sLL $1 $> $ NegApp noExt $2 noSyntaxExpr)
+exp10_top :: { ECP }
+        : '-' fexp                      { ECP $
+                                           runECP_PV $2 >>= \ $2 ->
+                                           amms (mkHsNegAppPV (comb2 $1 $>) $2)
                                                [mj AnnMinus $1] }
 
 
                                                [mj AnnMinus $1] }
 
 
-        | hpc_annot exp        {% runExpCmdP $2 >>= \ $2 ->
-                                  fmap ecFromExp $
+        | hpc_annot exp        {% runECP_P $2 >>= \ $2 ->
+                                  fmap ecpFromExp $
                                   ams (sLL $1 $> $ HsTickPragma noExt (snd $ fst $ fst $ unLoc $1)
                                                                 (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
                                       (fst $ fst $ fst $ unLoc $1) }
 
                                   ams (sLL $1 $> $ HsTickPragma noExt (snd $ fst $ fst $ unLoc $1)
                                                                 (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
                                       (fst $ fst $ fst $ unLoc $1) }
 
-        | '{-# CORE' STRING '#-}' exp  {% runExpCmdP $4 >>= \ $4 ->
-                                          fmap ecFromExp $
+        | '{-# CORE' STRING '#-}' exp  {% runECP_P $4 >>= \ $4 ->
+                                          fmap ecpFromExp $
                                           ams (sLL $1 $> $ HsCoreAnn noExt (getCORE_PRAGs $1) (getStringLiteral $2) $4)
                                               [mo $1,mj AnnVal $2
                                               ,mc $3] }
                                           -- hdaume: core annotation
         | fexp                         { $1 }
 
                                           ams (sLL $1 $> $ HsCoreAnn noExt (getCORE_PRAGs $1) (getStringLiteral $2) $4)
                                               [mo $1,mj AnnVal $2
                                               ,mc $3] }
                                           -- hdaume: core annotation
         | fexp                         { $1 }
 
-exp10 :: { ExpCmdP }
+exp10 :: { ECP }
         : exp10_top            { $1 }
         : exp10_top            { $1 }
-        | scc_annot exp        {% runExpCmdP $2 >>= \ $2 ->
-                                  fmap ecFromExp $
+        | scc_annot exp        {% runECP_P $2 >>= \ $2 ->
+                                  fmap ecpFromExp $
                                   ams (sLL $1 $> $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
                                       (fst $ fst $ unLoc $1) }
 
                                   ams (sLL $1 $> $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
                                       (fst $ fst $ unLoc $1) }
 
@@ -2668,175 +2677,172 @@ hpc_annot :: { Located ( (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,In
                                                 )))
                                          }
 
                                                 )))
                                          }
 
-fexp    :: { ExpCmdP }
-        : fexp aexp                  {% runExpCmdP $2 >>= \ $2 ->
-                                        runPV (checkBlockArguments $2) >>= \_ ->
-                                        return $ ExpCmdP $
-                                          runExpCmdPV $1 >>= \ $1 ->
-                                          checkBlockArguments $1 >>= \_ ->
-                                          return (sLL $1 $> (ecHsApp $1 $2)) }
-        | fexp TYPEAPP atype         {% runExpCmdP $1 >>= \ $1 ->
-                                        runPV (checkBlockArguments $1) >>= \_ ->
-                                        fmap ecFromExp $
+fexp    :: { ECP }
+        : fexp aexp                  { ECP $
+                                          superFunArg $
+                                          runECP_PV $1 >>= \ $1 ->
+                                          runECP_PV $2 >>= \ $2 ->
+                                          mkHsAppPV (comb2 $1 $>) $1 $2 }
+        | fexp TYPEAPP atype         {% runECP_P $1 >>= \ $1 ->
+                                        runPV (checkExpBlockArguments $1) >>= \_ ->
+                                        fmap ecpFromExp $
                                         ams (sLL $1 $> $ HsAppType noExt $1 (mkHsWildCardBndrs $3))
                                             [mj AnnAt $2] }
                                         ams (sLL $1 $> $ HsAppType noExt $1 (mkHsWildCardBndrs $3))
                                             [mj AnnAt $2] }
-        | 'static' aexp              {% runExpCmdP $2 >>= \ $2 ->
-                                        fmap ecFromExp $
+        | 'static' aexp              {% runECP_P $2 >>= \ $2 ->
+                                        fmap ecpFromExp $
                                         ams (sLL $1 $> $ HsStatic noExt $2)
                                             [mj AnnStatic $1] }
         | aexp                       { $1 }
 
                                         ams (sLL $1 $> $ HsStatic noExt $2)
                                             [mj AnnStatic $1] }
         | aexp                       { $1 }
 
-aexp    :: { ExpCmdP }
-        : qvar '@' aexp         {% runExpCmdP $3 >>= \ $3 ->
-                                   fmap ecFromExp $
-                                   ams (sLL $1 $> $ EAsPat noExt $1 $3) [mj AnnAt $2] }
+aexp    :: { ECP }
+        : qvar '@' aexp         { ECP $
+                                   runECP_PV $3 >>= \ $3 ->
+                                   amms (mkHsAsPatPV (comb2 $1 $>) $1 $3) [mj AnnAt $2] }
             -- If you change the parsing, make sure to understand
             -- Note [Lexing type applications] in Lexer.x
 
             -- If you change the parsing, make sure to understand
             -- Note [Lexing type applications] in Lexer.x
 
-        | '~' aexp              {% runExpCmdP $2 >>= \ $2 ->
-                                   fmap ecFromExp $
-                                   ams (sLL $1 $> $ ELazyPat noExt $2) [mj AnnTilde $1] }
+        | '~' aexp              { ECP $
+                                   runECP_PV $2 >>= \ $2 ->
+                                   amms (mkHsLazyPatPV (comb2 $1 $>) $2) [mj AnnTilde $1] }
 
         | '\\' apat apats '->' exp
 
         | '\\' apat apats '->' exp
-                   {  ExpCmdP $
-                      runExpCmdPV $5 >>= \ $5 ->
-                      ams (sLL $1 $> $ ecHsLam (mkMatchGroup FromSource
+                   {  ECP $
+                      runECP_PV $5 >>= \ $5 ->
+                      amms (mkHsLamPV (comb2 $1 $>) (mkMatchGroup FromSource
                             [sLL $1 $> $ Match { m_ext = noExt
                                                , m_ctxt = LambdaExpr
                                                , m_pats = $2:$3
                                                , m_grhss = unguardedGRHSs $5 }]))
                           [mj AnnLam $1, mu AnnRarrow $4] }
                             [sLL $1 $> $ Match { m_ext = noExt
                                                , m_ctxt = LambdaExpr
                                                , m_pats = $2:$3
                                                , m_grhss = unguardedGRHSs $5 }]))
                           [mj AnnLam $1, mu AnnRarrow $4] }
-        | 'let' binds 'in' exp          {  ExpCmdP $
-                                           runExpCmdPV $4 >>= \ $4 ->
-                                           ams (sLL $1 $> $ ecHsLet (snd (unLoc $2)) $4)
+        | 'let' binds 'in' exp          {  ECP $
+                                           runECP_PV $4 >>= \ $4 ->
+                                           amms (mkHsLetPV (comb2 $1 $>) (snd (unLoc $2)) $4)
                                                (mj AnnLet $1:mj AnnIn $3
                                                  :(fst $ unLoc $2)) }
         | '\\' 'lcase' altslist
             {% runPV $3 >>= \ $3 ->
                                                (mj AnnLet $1:mj AnnIn $3
                                                  :(fst $ unLoc $2)) }
         | '\\' 'lcase' altslist
             {% runPV $3 >>= \ $3 ->
-               fmap ecFromExp $
+               fmap ecpFromExp $
                ams (sLL $1 $> $ HsLamCase noExt
                                    (mkMatchGroup FromSource (snd $ unLoc $3)))
                    (mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) }
         | 'if' exp optSemi 'then' exp optSemi 'else' exp
                ams (sLL $1 $> $ HsLamCase noExt
                                    (mkMatchGroup FromSource (snd $ unLoc $3)))
                    (mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) }
         | 'if' exp optSemi 'then' exp optSemi 'else' exp
-                         {% runExpCmdP $2 >>= \ $2 ->
-                            return $ ExpCmdP $
-                              runExpCmdPV $5 >>= \ $5 ->
-                              runExpCmdPV $8 >>= \ $8 ->
-                              checkDoAndIfThenElse $2 (snd $3) $5 (snd $6) $8 >>
-                              ams (sLL $1 $> $ ecHsIf $2 $5 $8)
+                         {% runECP_P $2 >>= \ $2 ->
+                            return $ ECP $
+                              runECP_PV $5 >>= \ $5 ->
+                              runECP_PV $8 >>= \ $8 ->
+                              amms (mkHsIfPV (comb2 $1 $>) $2 (snd $3) $5 (snd $6) $8)
                                   (mj AnnIf $1:mj AnnThen $4
                                      :mj AnnElse $7
                                      :(map (\l -> mj AnnSemi l) (fst $3))
                                     ++(map (\l -> mj AnnSemi l) (fst $6))) }
         | 'if' ifgdpats                 {% hintMultiWayIf (getLoc $1) >>= \_ ->
                                   (mj AnnIf $1:mj AnnThen $4
                                      :mj AnnElse $7
                                      :(map (\l -> mj AnnSemi l) (fst $3))
                                     ++(map (\l -> mj AnnSemi l) (fst $6))) }
         | 'if' ifgdpats                 {% hintMultiWayIf (getLoc $1) >>= \_ ->
-                                           fmap ecFromExp $
+                                           fmap ecpFromExp $
                                            ams (sLL $1 $> $ HsMultiIf noExt
                                                      (reverse $ snd $ unLoc $2))
                                                (mj AnnIf $1:(fst $ unLoc $2)) }
                                            ams (sLL $1 $> $ HsMultiIf noExt
                                                      (reverse $ snd $ unLoc $2))
                                                (mj AnnIf $1:(fst $ unLoc $2)) }
-        | 'case' exp 'of' altslist    {% runExpCmdP $2 >>= \ $2 ->
-                                         return $ ExpCmdP $
+        | 'case' exp 'of' altslist    {% runECP_P $2 >>= \ $2 ->
+                                         return $ ECP $
                                            $4 >>= \ $4 ->
                                            $4 >>= \ $4 ->
-                                           ams (cL (comb3 $1 $3 $4) $
-                                                   ecHsCase $2 (mkMatchGroup
+                                           amms (mkHsCasePV (comb3 $1 $3 $4) $2 (mkMatchGroup
                                                    FromSource (snd $ unLoc $4)))
                                                (mj AnnCase $1:mj AnnOf $3
                                                   :(fst $ unLoc $4)) }
                                                    FromSource (snd $ unLoc $4)))
                                                (mj AnnCase $1:mj AnnOf $3
                                                   :(fst $ unLoc $4)) }
-        | 'do' stmtlist              { ExpCmdP $
+        | 'do' stmtlist              { ECP $
                                         $2 >>= \ $2 ->
                                         $2 >>= \ $2 ->
-                                        ams (cL (comb2 $1 $2)
-                                               (ecHsDo (mapLoc snd $2)))
+                                        amms (mkHsDoPV (comb2 $1 $2) (mapLoc snd $2))
                                                (mj AnnDo $1:(fst $ unLoc $2)) }
         | 'mdo' stmtlist            {% runPV $2 >>= \ $2 ->
                                                (mj AnnDo $1:(fst $ unLoc $2)) }
         | 'mdo' stmtlist            {% runPV $2 >>= \ $2 ->
-                                       fmap ecFromExp $
+                                       fmap ecpFromExp $
                                        ams (cL (comb2 $1 $2)
                                               (mkHsDo MDoExpr (snd $ unLoc $2)))
                                            (mj AnnMdo $1:(fst $ unLoc $2)) }
         | 'proc' aexp '->' exp
                                        ams (cL (comb2 $1 $2)
                                               (mkHsDo MDoExpr (snd $ unLoc $2)))
                                            (mj AnnMdo $1:(fst $ unLoc $2)) }
         | 'proc' aexp '->' exp
-                       {% (checkPattern <=< runExpCmdP) $2 >>= \ p ->
-                           runExpCmdP $4 >>= \ $4@cmd ->
-                           fmap ecFromExp $
+                       {% (checkPattern <=< runECP_P) $2 >>= \ p ->
+                           runECP_P $4 >>= \ $4@cmd ->
+                           fmap ecpFromExp $
                            ams (sLL $1 $> $ HsProc noExt p (sLL $1 $> $ HsCmdTop noExt cmd))
                                             -- TODO: is LL right here?
                                [mj AnnProc $1,mu AnnRarrow $3] }
 
         | aexp1                 { $1 }
 
                            ams (sLL $1 $> $ HsProc noExt p (sLL $1 $> $ HsCmdTop noExt cmd))
                                             -- TODO: is LL right here?
                                [mj AnnProc $1,mu AnnRarrow $3] }
 
         | aexp1                 { $1 }
 
-aexp1   :: { ExpCmdP }
-        : aexp1 '{' fbinds '}' {% runExpCmdP $1 >>= \ $1 ->
-                                  do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
-                                                                   (snd $3)
-                                     ; _ <- amsL (comb2 $1 $>) (moc $2:mcc $4:(fst $3))
-                                     ; fmap ecFromExp $
-                                       checkRecordSyntax (sLL $1 $> r) }}
+aexp1   :: { ECP }
+        : aexp1 '{' fbinds '}' { ECP $
+                                  runECP_PV $1 >>= \ $1 ->
+                                  $3 >>= \ $3 ->
+                                  amms (mkHsRecordPV (comb2 $1 $>) (comb2 $2 $4) $1 (snd $3))
+                                       (moc $2:mcc $4:(fst $3)) }
         | aexp2                { $1 }
 
         | aexp2                { $1 }
 
-aexp2   :: { ExpCmdP }
-        : qvar                          { ecFromExp $ sL1 $1 (HsVar noExt   $! $1) }
-        | qcon                          { ecFromExp $ sL1 $1 (HsVar noExt   $! $1) }
-        | ipvar                         { ecFromExp $ sL1 $1 (HsIPVar noExt $! unLoc $1) }
-        | overloaded_label              { ecFromExp $ sL1 $1 (HsOverLabel noExt Nothing $! unLoc $1) }
-        | literal                       { ecFromExp $ sL1 $1 (HsLit noExt  $! unLoc $1) }
+aexp2   :: { ECP }
+        : qvar                          { ECP $ mkHsVarPV $! $1 }
+        | qcon                          { ECP $ mkHsVarPV $! $1 }
+        | ipvar                         { ecpFromExp $ sL1 $1 (HsIPVar noExt $! unLoc $1) }
+        | overloaded_label              { ecpFromExp $ sL1 $1 (HsOverLabel noExt Nothing $! unLoc $1) }
+        | literal                       { ECP $ mkHsLitPV $! $1 }
 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
 -- into HsOverLit when -foverloaded-strings is on.
 --      | STRING    { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)
 --                                       (getSTRING $1) noExt) }
 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
 -- into HsOverLit when -foverloaded-strings is on.
 --      | STRING    { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)
 --                                       (getSTRING $1) noExt) }
-        | INTEGER   { ecFromExp $ sL (getLoc $1) (HsOverLit noExt $! mkHsIntegral   (getINTEGER $1) ) }
-        | RATIONAL  { ecFromExp $ sL (getLoc $1) (HsOverLit noExt $! mkHsFractional (getRATIONAL $1) ) }
+        | INTEGER   { ECP $ mkHsOverLitPV (sL1 $1 $ mkHsIntegral   (getINTEGER  $1)) }
+        | RATIONAL  { ECP $ mkHsOverLitPV (sL1 $1 $ mkHsFractional (getRATIONAL $1)) }
 
         -- N.B.: sections get parsed by these next two productions.
         -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
         -- correct Haskell (you'd have to write '((+ 3), (4 -))')
         -- but the less cluttered version fell out of having texps.
 
         -- N.B.: sections get parsed by these next two productions.
         -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
         -- correct Haskell (you'd have to write '((+ 3), (4 -))')
         -- but the less cluttered version fell out of having texps.
-        | '(' texp ')'                  { ExpCmdP $
-                                           runExpCmdPV $2 >>= \ $2 ->
-                                           ams (sLL $1 $> (ecHsPar $2)) [mop $1,mcp $3] }
-        | '(' tup_exprs ')'             {% do { e <- mkSumOrTuple Boxed (comb2 $1 $3) (snd $2)
-                                              ; fmap ecFromExp $
-                                                ams (sLL $1 $> e) ((mop $1:fst $2) ++ [mcp $3]) } }
-
-        | '(#' texp '#)'                {% runExpCmdP $2 >>= \ $2 ->
-                                           fmap ecFromExp $
-                                           ams (sLL $1 $> (ExplicitTuple noExt [cL (gl $2)
-                                                         (Present noExt $2)] Unboxed))
-                                               [mo $1,mc $3] }
-        | '(#' tup_exprs '#)'           {% do { e <- mkSumOrTuple Unboxed (comb2 $1 $3) (snd $2)
-                                              ; fmap ecFromExp $
-                                                ams (sLL $1 $> e) ((mo $1:fst $2) ++ [mc $3]) } }
-
-        | '[' list ']'      {% fmap ecFromExp $ ams (sLL $1 $> (snd $2)) (mos $1:mcs $3:(fst $2)) }
-        | '_'               { ecFromExp $ sL1 $1 $ EWildPat noExt }
+        | '(' texp ')'                  { ECP $
+                                           runECP_PV $2 >>= \ $2 ->
+                                           amms (mkHsParPV (comb2 $1 $>) $2) [mop $1,mcp $3] }
+        | '(' tup_exprs ')'             { ECP $
+                                           $2 >>= \ $2 ->
+                                           amms (mkSumOrTuplePV (comb2 $1 $>) Boxed (snd $2))
+                                                ((mop $1:fst $2) ++ [mcp $3]) }
+
+        | '(#' texp '#)'                { ECP $
+                                           runECP_PV $2 >>= \ $2 ->
+                                           amms (mkSumOrTuplePV (comb2 $1 $>) Unboxed (Tuple [cL (gl $2) (Just $2)]))
+                                                [mo $1,mc $3] }
+        | '(#' tup_exprs '#)'           { ECP $
+                                           $2 >>= \ $2 ->
+                                           amms (mkSumOrTuplePV (comb2 $1 $>) Unboxed (snd $2))
+                                                ((mo $1:fst $2) ++ [mc $3]) }
+
+        | '[' list ']'      { ECP $ $2 (comb2 $1 $>) >>= \a -> ams a [mos $1,mcs $3] }
+        | '_'               { ECP $ mkHsWildCardPV (getLoc $1) }
 
         -- Template Haskell Extension
 
         -- Template Haskell Extension
-        | splice_exp            { ecFromExp $1 }
+        | splice_untyped { ECP $ mkHsSplicePV $1 }
+        | splice_typed   { ecpFromExp $ mapLoc (HsSpliceE noExt) $1 }
 
 
-        | SIMPLEQUOTE  qvar     {% fmap ecFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
-        | SIMPLEQUOTE  qcon     {% fmap ecFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
-        | TH_TY_QUOTE tyvar     {% fmap ecFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
-        | TH_TY_QUOTE gtycon    {% fmap ecFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
+        | SIMPLEQUOTE  qvar     {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
+        | SIMPLEQUOTE  qcon     {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
+        | TH_TY_QUOTE tyvar     {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
+        | TH_TY_QUOTE gtycon    {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
         | TH_TY_QUOTE {- nothing -} {% reportEmptyDoubleQuotes (getLoc $1) }
         | TH_TY_QUOTE {- nothing -} {% reportEmptyDoubleQuotes (getLoc $1) }
-        | '[|' exp '|]'       {% runExpCmdP $2 >>= \ $2 ->
-                                 fmap ecFromExp $
+        | '[|' exp '|]'       {% runECP_P $2 >>= \ $2 ->
+                                 fmap ecpFromExp $
                                  ams (sLL $1 $> $ HsBracket noExt (ExpBr noExt $2))
                                       (if (hasE $1) then [mj AnnOpenE $1, mu AnnCloseQ $3]
                                                     else [mu AnnOpenEQ $1,mu AnnCloseQ $3]) }
                                  ams (sLL $1 $> $ HsBracket noExt (ExpBr noExt $2))
                                       (if (hasE $1) then [mj AnnOpenE $1, mu AnnCloseQ $3]
                                                     else [mu AnnOpenEQ $1,mu AnnCloseQ $3]) }
-        | '[||' exp '||]'     {% runExpCmdP $2 >>= \ $2 ->
-                                 fmap ecFromExp $
+        | '[||' exp '||]'     {% runECP_P $2 >>= \ $2 ->
+                                 fmap ecpFromExp $
                                  ams (sLL $1 $> $ HsBracket noExt (TExpBr noExt $2))
                                       (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) }
                                  ams (sLL $1 $> $ HsBracket noExt (TExpBr noExt $2))
                                       (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) }
-        | '[t|' ktype '|]'    {% fmap ecFromExp $
+        | '[t|' ktype '|]'    {% fmap ecpFromExp $
                                  ams (sLL $1 $> $ HsBracket noExt (TypBr noExt $2)) [mo $1,mu AnnCloseQ $3] }
                                  ams (sLL $1 $> $ HsBracket noExt (TypBr noExt $2)) [mo $1,mu AnnCloseQ $3] }
-        | '[p|' infixexp '|]' {% (checkPattern <=< runExpCmdP) $2 >>= \p ->
-                                      fmap ecFromExp $
+        | '[p|' infixexp '|]' {% (checkPattern <=< runECP_P) $2 >>= \p ->
+                                      fmap ecpFromExp $
                                       ams (sLL $1 $> $ HsBracket noExt (PatBr noExt p))
                                           [mo $1,mu AnnCloseQ $3] }
                                       ams (sLL $1 $> $ HsBracket noExt (PatBr noExt p))
                                           [mo $1,mu AnnCloseQ $3] }
-        | '[d|' cvtopbody '|]' {% fmap ecFromExp $
+        | '[d|' cvtopbody '|]' {% fmap ecpFromExp $
                                   ams (sLL $1 $> $ HsBracket noExt (DecBrL noExt (snd $2)))
                                       (mo $1:mu AnnCloseQ $3:fst $2) }
                                   ams (sLL $1 $> $ HsBracket noExt (DecBrL noExt (snd $2)))
                                       (mo $1:mu AnnCloseQ $3:fst $2) }
-        | quasiquote          { ecFromExp $ sL1 $1 (HsSpliceE noExt (unLoc $1)) }
+        | quasiquote          { ECP $ mkHsSplicePV $1 }
 
         -- arrow notation extension
 
         -- arrow notation extension
-        | '(|' aexp2 cmdargs '|)'  {% runExpCmdP $2 >>= \ $2 ->
-                                      fmap ecFromCmd $
+        | '(|' aexp2 cmdargs '|)'  {% runECP_P $2 >>= \ $2 ->
+                                      fmap ecpFromCmd $
                                       ams (sLL $1 $> $ HsCmdArrForm noExt $2 Prefix
                                                            Nothing (reverse $3))
                                           [mu AnnOpenB $1,mu AnnCloseB $4] }
                                       ams (sLL $1 $> $ HsCmdArrForm noExt $2 Prefix
                                                            Nothing (reverse $3))
                                           [mu AnnOpenB $1,mu AnnCloseB $4] }
@@ -2850,7 +2856,7 @@ splice_untyped :: { Located (HsSplice GhcPs) }
                                         (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
                                                            (getTH_ID_SPLICE $1)))))
                                        [mj AnnThIdSplice $1] }
                                         (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
                                                            (getTH_ID_SPLICE $1)))))
                                        [mj AnnThIdSplice $1] }
-        | '$(' exp ')'          {% runExpCmdP $2 >>= \ $2 ->
+        | '$(' exp ')'          {% runECP_P $2 >>= \ $2 ->
                                    ams (sLL $1 $> $ mkUntypedSplice HasParens $2)
                                        [mj AnnOpenPE $1,mj AnnCloseP $3] }
 
                                    ams (sLL $1 $> $ mkUntypedSplice HasParens $2)
                                        [mj AnnOpenPE $1,mj AnnCloseP $3] }
 
@@ -2859,7 +2865,7 @@ splice_typed :: { Located (HsSplice GhcPs) }
                                         (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
                                                         (getTH_ID_TY_SPLICE $1)))))
                                        [mj AnnThIdTySplice $1] }
                                         (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
                                                         (getTH_ID_TY_SPLICE $1)))))
                                        [mj AnnThIdTySplice $1] }
-        | '$$(' exp ')'         {% runExpCmdP $2 >>= \ $2 ->
+        | '$$(' exp ')'         {% runECP_P $2 >>= \ $2 ->
                                     ams (sLL $1 $> $ mkTypedSplice HasParens $2)
                                        [mj AnnOpenPTE $1,mj AnnCloseP $3] }
 
                                     ams (sLL $1 $> $ mkTypedSplice HasParens $2)
                                        [mj AnnOpenPTE $1,mj AnnCloseP $3] }
 
@@ -2868,7 +2874,7 @@ cmdargs :: { [LHsCmdTop GhcPs] }
         | {- empty -}                   { [] }
 
 acmd    :: { LHsCmdTop GhcPs }
         | {- empty -}                   { [] }
 
 acmd    :: { LHsCmdTop GhcPs }
-        : aexp2                 {% runExpCmdP $1 >>= \ cmd ->
+        : aexp2                 {% runECP_P $1 >>= \ cmd ->
                                     return (sL1 cmd $ HsCmdTop noExt cmd) }
 
 cvtopbody :: { ([AddAnn],[LHsDecl GhcPs]) }
                                     return (sL1 cmd $ HsCmdTop noExt cmd) }
 
 cvtopbody :: { ([AddAnn],[LHsDecl GhcPs]) }
@@ -2886,7 +2892,7 @@ cvtopdecls0 :: { [LHsDecl GhcPs] }
 -- "texp" is short for tuple expressions:
 -- things that can appear unparenthesized as long as they're
 -- inside parens or delimitted by commas
 -- "texp" is short for tuple expressions:
 -- things that can appear unparenthesized as long as they're
 -- inside parens or delimitted by commas
-texp :: { ExpCmdP }
+texp :: { ECP }
         : exp                           { $1 }
 
         -- Note [Parsing sections]
         : exp                           { $1 }
 
         -- Note [Parsing sections]
@@ -2900,98 +2906,112 @@ texp :: { ExpCmdP }
         -- Then when converting expr to pattern we unravel it again
         -- Meanwhile, the renamer checks that real sections appear
         -- inside parens.
         -- Then when converting expr to pattern we unravel it again
         -- Meanwhile, the renamer checks that real sections appear
         -- inside parens.
-        | infixexp qop       {% runExpCmdP $1 >>= \ $1 ->
-                                return $ ecFromExp $
+        | infixexp qop       {% runECP_P $1 >>= \ $1 ->
+                                runPV $2 >>= \ $2 ->
+                                return $ ecpFromExp $
                                 sLL $1 $> $ SectionL noExt $1 $2 }
                                 sLL $1 $> $ SectionL noExt $1 $2 }
-        | qopm infixexp      {% runExpCmdP $2 >>= \ $2 ->
-                                return $ ecFromExp $
-                                sLL $1 $> $ SectionR noExt $1 $2 }
+        | qopm infixexp      { ECP $
+                                superInfixOp $
+                                runECP_PV $2 >>= \ $2 ->
+                                $1 >>= \ $1 ->
+                                mkHsSectionR_PV (comb2 $1 $>) $1 $2 }
 
        -- View patterns get parenthesized above
 
        -- View patterns get parenthesized above
-        | exp '->' texp   {% runExpCmdP $1 >>= \ $1 ->
-                             runExpCmdP $3 >>= \ $3 ->
-                             fmap ecFromExp $
-                             ams (sLL $1 $> $ EViewPat noExt $1 $3) [mu AnnRarrow $2] }
+        | exp '->' texp   { ECP $
+                             runECP_PV $1 >>= \ $1 ->
+                             runECP_PV $3 >>= \ $3 ->
+                             amms (mkHsViewPatPV (comb2 $1 $>) $1 $3) [mu AnnRarrow $2] }
 
 -- Always at least one comma or bar.
 
 -- Always at least one comma or bar.
-tup_exprs :: { ([AddAnn],SumOrTuple) }
+tup_exprs :: { forall b. DisambECP b => PV ([AddAnn],SumOrTuple b) }
            : texp commas_tup_tail
            : texp commas_tup_tail
-                          {% runExpCmdP $1 >>= \ $1 ->
+                           { runECP_PV $1 >>= \ $1 ->
+                             $2 >>= \ $2 ->
                              do { addAnnotation (gl $1) AnnComma (fst $2)
                              do { addAnnotation (gl $1) AnnComma (fst $2)
-                                ; return ([],Tuple ((sL1 $1 (Present noExt $1)) : snd $2)) } }
+                                ; return ([],Tuple ((sL1 $1 (Just $1)) : snd $2)) } }
 
 
-           | texp bars   {% runExpCmdP $1 >>= \ $1 -> return $
+           | texp bars   { runECP_PV $1 >>= \ $1 -> return $
                             (mvbars (fst $2), Sum 1  (snd $2 + 1) $1) }
 
            | commas tup_tail
                             (mvbars (fst $2), Sum 1  (snd $2 + 1) $1) }
 
            | commas tup_tail
-                {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1)
+                 { $2 >>= \ $2 ->
+                   do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1)
                       ; return
                       ; return
-                           ([],Tuple (map (\l -> cL l missingTupArg) (fst $1) ++ $2)) } }
+                           ([],Tuple (map (\l -> cL l Nothing) (fst $1) ++ $2)) } }
 
            | bars texp bars0
 
            | bars texp bars0
-                {% runExpCmdP $2 >>= \ $2 -> return $
+                { runECP_PV $2 >>= \ $2 -> return $
                   (mvbars (fst $1) ++ mvbars (fst $3), Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2) }
 
 -- Always starts with commas; always follows an expr
                   (mvbars (fst $1) ++ mvbars (fst $3), Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2) }
 
 -- Always starts with commas; always follows an expr
-commas_tup_tail :: { (SrcSpan,[LHsTupArg GhcPs]) }
+commas_tup_tail :: { forall b. DisambECP b => PV (SrcSpan,[Located (Maybe (Located b))]) }
 commas_tup_tail : commas tup_tail
 commas_tup_tail : commas tup_tail
-       {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (tail $ fst $1)
+        { $2 >>= \ $2 ->
+          do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (tail $ fst $1)
              ; return (
             (head $ fst $1
              ; return (
             (head $ fst $1
-            ,(map (\l -> cL l missingTupArg) (tail $ fst $1)) ++ $2)) } }
+            ,(map (\l -> cL l Nothing) (tail $ fst $1)) ++ $2)) } }
 
 -- Always follows a comma
 
 -- Always follows a comma
-tup_tail :: { [LHsTupArg GhcPs] }
-          : texp commas_tup_tail {% runExpCmdP $1 >>= \ $1 ->
-                                    addAnnotation (gl $1) AnnComma (fst $2) >>
-                                    return ((cL (gl $1) (Present noExt $1)) : snd $2) }
-          | texp                 {% runExpCmdP $1 >>= \ $1 ->
-                                    return [cL (gl $1) (Present noExt $1)] }
-          | {- empty -}          { [noLoc missingTupArg] }
+tup_tail :: { forall b. DisambECP b => PV [Located (Maybe (Located b))] }
+          : texp commas_tup_tail { runECP_PV $1 >>= \ $1 ->
+                                   $2 >>= \ $2 ->
+                                   addAnnotation (gl $1) AnnComma (fst $2) >>
+                                   return ((cL (gl $1) (Just $1)) : snd $2) }
+          | texp                 { runECP_PV $1 >>= \ $1 ->
+                                   return [cL (gl $1) (Just $1)] }
+          | {- empty -}          { return [noLoc Nothing] }
 
 -----------------------------------------------------------------------------
 -- List expressions
 
 -- The rules below are little bit contorted to keep lexps left-recursive while
 -- avoiding another shift/reduce-conflict.
 
 -----------------------------------------------------------------------------
 -- List expressions
 
 -- The rules below are little bit contorted to keep lexps left-recursive while
 -- avoiding another shift/reduce-conflict.
-list :: { ([AddAnn],HsExpr GhcPs) }
-        : texp    {% runExpCmdP $1 >>= \ $1 ->
-                     return ([],ExplicitList noExt Nothing [$1]) }
-        | lexps   { ([],ExplicitList noExt Nothing (reverse (unLoc $1))) }
-        | texp '..'             {% runExpCmdP $1 >>= \ $1 ->
-                                  return ([mj AnnDotdot $2],
-                                      ArithSeq noExt Nothing (From $1)) }
-        | texp ',' exp '..'     {% runExpCmdP $1 >>= \ $1 ->
-                                   runExpCmdP $3 >>= \ $3 ->
-                                  return ([mj AnnComma $2,mj AnnDotdot $4],
-                                  ArithSeq noExt Nothing
-                                                             (FromThen $1 $3)) }
-        | texp '..' exp         {% runExpCmdP $1 >>= \ $1 ->
-                                   runExpCmdP $3 >>= \ $3 ->
-                                  return ([mj AnnDotdot $2],
-                                   ArithSeq noExt Nothing
-                                                               (FromTo $1 $3)) }
-        | texp ',' exp '..' exp {% runExpCmdP $1 >>= \ $1 ->
-                                   runExpCmdP $3 >>= \ $3 ->
-                                   runExpCmdP $5 >>= \ $5 ->
-                                  return ([mj AnnComma $2,mj AnnDotdot $4],
-                                    ArithSeq noExt Nothing
-                                                (FromThenTo $1 $3 $5)) }
+list :: { forall b. DisambECP b => SrcSpan -> PV (Located b) }
+        : texp    { \loc -> runECP_PV $1 >>= \ $1 ->
+                            mkHsExplicitListPV loc [$1] }
+        | lexps   { \loc -> $1 >>= \ $1 ->
+                            mkHsExplicitListPV loc (reverse $1) }
+        | texp '..'  { \loc ->    runECP_PV $1 >>= \ $1 ->
+                                  ams (cL loc $ ArithSeq noExt Nothing (From $1))
+                                      [mj AnnDotdot $2]
+                                      >>= ecpFromExp' }
+        | texp ',' exp '..' { \loc ->
+                                   runECP_PV $1 >>= \ $1 ->
+                                   runECP_PV $3 >>= \ $3 ->
+                                   ams (cL loc $ ArithSeq noExt Nothing (FromThen $1 $3))
+                                       [mj AnnComma $2,mj AnnDotdot $4]
+                                       >>= ecpFromExp' }
+        | texp '..' exp  { \loc -> runECP_PV $1 >>= \ $1 ->
+                                   runECP_PV $3 >>= \ $3 ->
+                                   ams (cL loc $ ArithSeq noExt Nothing (FromTo $1 $3))
+                                       [mj AnnDotdot $2]
+                                       >>= ecpFromExp' }
+        | texp ',' exp '..' exp { \loc ->
+                                   runECP_PV $1 >>= \ $1 ->
+                                   runECP_PV $3 >>= \ $3 ->
+                                   runECP_PV $5 >>= \ $5 ->
+                                   ams (cL loc $ ArithSeq noExt Nothing (FromThenTo $1 $3 $5))
+                                       [mj AnnComma $2,mj AnnDotdot $4]
+                                       >>= ecpFromExp' }
         | texp '|' flattenedpquals
         | texp '|' flattenedpquals
-             {% checkMonadComp >>= \ ctxt ->
-                runExpCmdP $1 >>= \ $1 ->
-                return ([mj AnnVbar $2],
-                        mkHsComp ctxt (unLoc $3) $1) }
-
-lexps :: { Located [LHsExpr GhcPs] }
-        : lexps ',' texp          {% runExpCmdP $3 >>= \ $3 ->
-                                     addAnnotation (gl $ head $ unLoc $1)
+             { \loc ->
+                checkMonadComp >>= \ ctxt ->
+                runECP_PV $1 >>= \ $1 ->
+                ams (cL loc $ mkHsComp ctxt (unLoc $3) $1)
+                    [mj AnnVbar $2]
+                    >>= ecpFromExp' }
+
+lexps :: { forall b. DisambECP b => PV [Located b] }
+        : lexps ',' texp           { $1 >>= \ $1 ->
+                                     runECP_PV $3 >>= \ $3 ->
+                                     addAnnotation (gl $ head $ $1)
                                                             AnnComma (gl $2) >>
                                                             AnnComma (gl $2) >>
-                                      return (sLL $1 $> (((:) $! $3) $! unLoc $1)) }
-        | texp ',' texp            {% runExpCmdP $1 >>= \ $1 ->
-                                      runExpCmdP $3 >>= \ $3 ->
+                                      return (((:) $! $3) $! $1) }
+        | texp ',' texp             { runECP_PV $1 >>= \ $1 ->
+                                      runECP_PV $3 >>= \ $3 ->
                                       addAnnotation (gl $1) AnnComma (gl $2) >>
                                       addAnnotation (gl $1) AnnComma (gl $2) >>
-                                      return (sLL $1 $> [$3,$1]) }
+                                      return [$3,$1] }
 
 -----------------------------------------------------------------------------
 -- List Comprehensions
 
 -----------------------------------------------------------------------------
 -- List Comprehensions
@@ -3039,20 +3059,20 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }   -- In reverse order, becau
 
 transformqual :: { Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs)) }
                         -- Function is applied to a list of stmts *in order*
 
 transformqual :: { Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs)) }
                         -- Function is applied to a list of stmts *in order*
-    : 'then' exp              {% runExpCmdP $2 >>= \ $2 -> return $
+    : 'then' exp              {% runECP_P $2 >>= \ $2 -> return $
                                  sLL $1 $> ([mj AnnThen $1], \ss -> (mkTransformStmt ss $2)) }
                                  sLL $1 $> ([mj AnnThen $1], \ss -> (mkTransformStmt ss $2)) }
-    | 'then' exp 'by' exp     {% runExpCmdP $2 >>= \ $2 ->
-                                 runExpCmdP $4 >>= \ $4 ->
+    | 'then' exp 'by' exp     {% runECP_P $2 >>= \ $2 ->
+                                 runECP_P $4 >>= \ $4 ->
                                  return $ sLL $1 $> ([mj AnnThen $1,mj AnnBy  $3],
                                                      \ss -> (mkTransformByStmt ss $2 $4)) }
     | 'then' 'group' 'using' exp
                                  return $ sLL $1 $> ([mj AnnThen $1,mj AnnBy  $3],
                                                      \ss -> (mkTransformByStmt ss $2 $4)) }
     | 'then' 'group' 'using' exp
-            {% runExpCmdP $4 >>= \ $4 ->
+            {% runECP_P $4 >>= \ $4 ->
                return $ sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3],
                                    \ss -> (mkGroupUsingStmt ss $4)) }
 
     | 'then' 'group' 'by' exp 'using' exp
                return $ sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3],
                                    \ss -> (mkGroupUsingStmt ss $4)) }
 
     | 'then' 'group' 'by' exp 'using' exp
-            {% runExpCmdP $4 >>= \ $4 ->
-               runExpCmdP $6 >>= \ $6 ->
+            {% runECP_P $4 >>= \ $4 ->
+               runECP_P $6 >>= \ $6 ->
                return $ sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5],
                                    \ss -> (mkGroupByUsingStmt ss $4 $6)) }
 
                return $ sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5],
                                    \ss -> (mkGroupByUsingStmt ss $4 $6)) }
 
@@ -3078,7 +3098,7 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
 -----------------------------------------------------------------------------
 -- Case alternatives
 
 -----------------------------------------------------------------------------
 -- Case alternatives
 
-altslist :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LMatch GhcPs (Located (b GhcPs))])) }
+altslist :: { forall b. DisambECP b => PV (Located ([AddAnn],[LMatch GhcPs (Located b)])) }
         : '{'            alts '}'  { $2 >>= \ $2 -> return $
                                      sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
                                                ,(reverse (snd $ unLoc $2))) }
         : '{'            alts '}'  { $2 >>= \ $2 -> return $
                                      sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
                                                ,(reverse (snd $ unLoc $2))) }
@@ -3088,14 +3108,14 @@ altslist :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LMatch GhcPs (Locate
         | '{'                 '}'    { return $ sLL $1 $> ([moc $1,mcc $2],[]) }
         |     vocurly          close { return $ noLoc ([],[]) }
 
         | '{'                 '}'    { return $ sLL $1 $> ([moc $1,mcc $2],[]) }
         |     vocurly          close { return $ noLoc ([],[]) }
 
-alts    :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LMatch GhcPs (Located (b GhcPs))])) }
+alts    :: { forall b. DisambECP b => PV (Located ([AddAnn],[LMatch GhcPs (Located b)])) }
         : alts1                    { $1 >>= \ $1 -> return $
                                      sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
         | ';' alts                 { $2 >>= \ $2 -> return $
                                      sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2))
                                                ,snd $ unLoc $2) }
 
         : alts1                    { $1 >>= \ $1 -> return $
                                      sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
         | ';' alts                 { $2 >>= \ $2 -> return $
                                      sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2))
                                                ,snd $ unLoc $2) }
 
-alts1   :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LMatch GhcPs (Located (b GhcPs))])) }
+alts1   :: { forall b. DisambECP b => PV (Located ([AddAnn],[LMatch GhcPs (Located b)])) }
         : alts1 ';' alt         { $1 >>= \ $1 ->
                                   $3 >>= \ $3 ->
                                      if null (snd $ unLoc $1)
         : alts1 ';' alt         { $1 >>= \ $1 ->
                                   $3 >>= \ $3 ->
                                      if null (snd $ unLoc $1)
@@ -3113,7 +3133,7 @@ alts1   :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LMatch GhcPs (Located
                                            >> return (sLL $1 $> ([],snd $ unLoc $1))) }
         | alt                   { $1 >>= \ $1 -> return $ sL1 $1 ([],[$1]) }
 
                                            >> return (sLL $1 $> ([],snd $ unLoc $1))) }
         | alt                   { $1 >>= \ $1 -> return $ sL1 $1 ([],[$1]) }
 
-alt     :: { forall b. ExpCmdI b => PV (LMatch GhcPs (Located (b GhcPs))) }
+alt     :: { forall b. DisambECP b => PV (LMatch GhcPs (Located b)) }
            : pat alt_rhs  { $2 >>= \ $2 ->
                             ams (sLL $1 $> (Match { m_ext = noExt
                                                   , m_ctxt = CaseAlt
            : pat alt_rhs  { $2 >>= \ $2 ->
                             ams (sLL $1 $> (Match { m_ext = noExt
                                                   , m_ctxt = CaseAlt
@@ -3121,18 +3141,18 @@ alt     :: { forall b. ExpCmdI b => PV (LMatch GhcPs (Located (b GhcPs))) }
                                                   , m_grhss = snd $ unLoc $2 }))
                                       (fst $ unLoc $2)}
 
                                                   , m_grhss = snd $ unLoc $2 }))
                                       (fst $ unLoc $2)}
 
-alt_rhs :: { forall b. ExpCmdI b => PV (Located ([AddAnn],GRHSs GhcPs (Located (b GhcPs)))) }
+alt_rhs :: { forall b. DisambECP b => PV (Located ([AddAnn],GRHSs GhcPs (Located b))) }
         : ralt wherebinds           { $1 >>= \alt ->
                                       return $ sLL alt $> (fst $ unLoc $2, GRHSs noExt (unLoc alt) (snd $ unLoc $2)) }
 
         : ralt wherebinds           { $1 >>= \alt ->
                                       return $ sLL alt $> (fst $ unLoc $2, GRHSs noExt (unLoc alt) (snd $ unLoc $2)) }
 
-ralt :: { forall b. ExpCmdI b => PV (Located [LGRHS GhcPs (Located (b GhcPs))]) }
-        : '->' exp            { runExpCmdPV $2 >>= \ $2 ->
+ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (Located b)]) }
+        : '->' exp            { runECP_PV $2 >>= \ $2 ->
                                 ams (sLL $1 $> (unguardedRHS (comb2 $1 $2) $2))
                                     [mu AnnRarrow $1] }
         | gdpats              { $1 >>= \gdpats ->
                                 return $ sL1 gdpats (reverse (unLoc gdpats)) }
 
                                 ams (sLL $1 $> (unguardedRHS (comb2 $1 $2) $2))
                                     [mu AnnRarrow $1] }
         | gdpats              { $1 >>= \gdpats ->
                                 return $ sL1 gdpats (reverse (unLoc gdpats)) }
 
-gdpats :: { forall b. ExpCmdI b => PV (Located [LGRHS GhcPs (Located (b GhcPs))]) }
+gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (Located b)]) }
         : gdpats gdpat { $1 >>= \gdpats ->
                          $2 >>= \gdpat ->
                          return $ sLL gdpats gdpat (gdpat : unLoc gdpats) }
         : gdpats gdpat { $1 >>= \gdpats ->
                          $2 >>= \gdpat ->
                          return $ sLL gdpats gdpat (gdpat : unLoc gdpats) }
@@ -3147,9 +3167,9 @@ ifgdpats :: { Located ([AddAnn],[LGRHS GhcPs (LHsExpr GhcPs)]) }
          |     gdpats close               {% runPV $1 >>= \ $1 ->
                                              return $ sL1 $1 ([],unLoc $1) }
 
          |     gdpats close               {% runPV $1 >>= \ $1 ->
                                              return $ sL1 $1 ([],unLoc $1) }
 
-gdpat   :: { forall b. ExpCmdI b => PV (LGRHS GhcPs (Located (b GhcPs))) }
+gdpat   :: { forall b. DisambECP b => PV (LGRHS GhcPs (Located b)) }
         : '|' guardquals '->' exp
         : '|' guardquals '->' exp
-                                   { runExpCmdPV $4 >>= \ $4 ->
+                                   { runECP_PV $4 >>= \ $4 ->
                                      ams (sL (comb2 $1 $>) $ GRHS noExt (unLoc $2) $4)
                                          [mj AnnVbar $1,mu AnnRarrow $3] }
 
                                      ams (sL (comb2 $1 $>) $ GRHS noExt (unLoc $2) $4)
                                          [mj AnnVbar $1,mu AnnRarrow $3] }
 
@@ -3158,28 +3178,24 @@ gdpat   :: { forall b. ExpCmdI b => PV (LGRHS GhcPs (Located (b GhcPs))) }
 -- Bangs inside are parsed as infix operator applications, so that
 -- we parse them right when bang-patterns are off
 pat     :: { LPat GhcPs }
 -- Bangs inside are parsed as infix operator applications, so that
 -- we parse them right when bang-patterns are off
 pat     :: { LPat GhcPs }
-pat     :  exp          {% (checkPattern <=< runExpCmdP) $1 }
-        | '!' aexp      {% runExpCmdP $2 >>= \ $2 ->
-                           amms (checkPattern (sLL $1 $> (SectionR noExt
-                                                     (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
+pat     :  exp          {% (checkPattern <=< runECP_P) $1 }
+        | '!' aexp      {% runECP_P $2 >>= \ $2 ->
+                           amms (checkPattern (patBuilderBang (getLoc $1) $2))
                                 [mj AnnBang $1] }
 
 bindpat :: { LPat GhcPs }
                                 [mj AnnBang $1] }
 
 bindpat :: { LPat GhcPs }
-bindpat :  exp            {% runExpCmdP $1 >>= \ $1 ->
-                             -- See Note [Parser-Validator ReaderT SDoc] in RdrHsSyn
-                             checkPattern_msg (text "Possibly caused by a missing 'do'?") $1 }
-        | '!' aexp        {% runExpCmdP $2 >>= \ $2 ->
-                             -- See Note [Parser-Validator ReaderT SDoc] in RdrHsSyn
+bindpat :  exp            {% -- See Note [Parser-Validator ReaderT SDoc] in RdrHsSyn
+                             checkPattern_msg (text "Possibly caused by a missing 'do'?")
+                                              (runECP_PV $1) }
+        | '!' aexp        {% -- See Note [Parser-Validator ReaderT SDoc] in RdrHsSyn
                              amms (checkPattern_msg (text "Possibly caused by a missing 'do'?")
                              amms (checkPattern_msg (text "Possibly caused by a missing 'do'?")
-                                     (sLL $1 $> (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
+                                     (patBuilderBang (getLoc $1) `fmap` runECP_PV $2))
                                   [mj AnnBang $1] }
 
 apat   :: { LPat GhcPs }
                                   [mj AnnBang $1] }
 
 apat   :: { LPat GhcPs }
-apat    : aexp                  {% (checkPattern <=< runExpCmdP) $1 }
-        | '!' aexp              {% runExpCmdP $2 >>= \ $2 ->
-                                   amms (checkPattern
-                                            (sLL $1 $> (SectionR noExt
-                                                (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
+apat    : aexp                  {% (checkPattern <=< runECP_P) $1 }
+        | '!' aexp              {% runECP_P $2 >>= \ $2 ->
+                                   amms (checkPattern (patBuilderBang (getLoc $1) $2))
                                         [mj AnnBang $1] }
 
 apats  :: { [LPat GhcPs] }
                                         [mj AnnBang $1] }
 
 apats  :: { [LPat GhcPs] }
@@ -3189,7 +3205,7 @@ apats  :: { [LPat GhcPs] }
 -----------------------------------------------------------------------------
 -- Statement sequences
 
 -----------------------------------------------------------------------------
 -- Statement sequences
 
-stmtlist :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LStmt GhcPs (Located (b GhcPs))])) }
+stmtlist :: { forall b. DisambECP b => PV (Located ([AddAnn],[LStmt GhcPs (Located b)])) }
         : '{'           stmts '}'       { $2 >>= \ $2 -> return $
                                           sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
                                              ,(reverse $ snd $ unLoc $2)) } -- AZ:performance of reverse?
         : '{'           stmts '}'       { $2 >>= \ $2 -> return $
                                           sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
                                              ,(reverse $ snd $ unLoc $2)) } -- AZ:performance of reverse?
@@ -3203,7 +3219,7 @@ stmtlist :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LStmt GhcPs (Located
 -- So we use BodyStmts throughout, and switch the last one over
 -- in ParseUtils.checkDo instead
 
 -- So we use BodyStmts throughout, and switch the last one over
 -- in ParseUtils.checkDo instead
 
-stmts :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LStmt GhcPs (Located (b GhcPs))])) }
+stmts :: { forall b. DisambECP b => PV (Located ([AddAnn],[LStmt GhcPs (Located b)])) }
         : stmts ';' stmt  { $1 >>= \ $1 ->
                             $3 >>= \ $3 ->
                             if null (snd $ unLoc $1)
         : stmts ';' stmt  { $1 >>= \ $1 ->
                             $3 >>= \ $3 ->
                             if null (snd $ unLoc $1)
@@ -3236,17 +3252,17 @@ maybe_stmt :: { Maybe (LStmt GhcPs (LHsExpr GhcPs)) }
 e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) }
         : stmt                          {% runPV $1 }
 
 e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) }
         : stmt                          {% runPV $1 }
 
-stmt  :: { forall b. ExpCmdI b => PV (LStmt GhcPs (Located (b GhcPs))) }
+stmt  :: { forall b. DisambECP b => PV (LStmt GhcPs (Located b)) }
         : qual                          { $1 }
         | 'rec' stmtlist                {  $2 >>= \ $2 ->
                                            ams (sLL $1 $> $ mkRecStmt (snd $ unLoc $2))
                                                (mj AnnRec $1:(fst $ unLoc $2)) }
 
         : qual                          { $1 }
         | 'rec' stmtlist                {  $2 >>= \ $2 ->
                                            ams (sLL $1 $> $ mkRecStmt (snd $ unLoc $2))
                                                (mj AnnRec $1:(fst $ unLoc $2)) }
 
-qual  :: { forall b. ExpCmdI b => PV (LStmt GhcPs (Located (b GhcPs))) }
-    : bindpat '<-' exp                   { runExpCmdPV $3 >>= \ $3 ->
+qual  :: { forall b. DisambECP b => PV (LStmt GhcPs (Located b)) }
+    : bindpat '<-' exp                   { runECP_PV $3 >>= \ $3 ->
                                            ams (sLL $1 $> $ mkBindStmt $1 $3)
                                                [mu AnnLarrow $2] }
                                            ams (sLL $1 $> $ mkBindStmt $1 $3)
                                                [mu AnnLarrow $2] }
-    | exp                                { runExpCmdPV $1 >>= \ $1 ->
+    | exp                                { runECP_PV $1 >>= \ $1 ->
                                            return $ sL1 $1 $ mkBodyStmt $1 }
     | 'let' binds                        { ams (sLL $1 $> $ LetStmt noExt (snd $ unLoc $2))
                                                (mj AnnLet $1:(fst $ unLoc $2)) }
                                            return $ sL1 $1 $ mkBodyStmt $1 }
     | 'let' binds                        { ams (sLL $1 $> $ LetStmt noExt (snd $ unLoc $2))
                                                (mj AnnLet $1:(fst $ unLoc $2)) }
@@ -3254,26 +3270,30 @@ qual  :: { forall b. ExpCmdI b => PV (LStmt GhcPs (Located (b GhcPs))) }
 -----------------------------------------------------------------------------
 -- Record Field Update/Construction
 
 -----------------------------------------------------------------------------
 -- Record Field Update/Construction
 
-fbinds  :: { ([AddAnn],([LHsRecField GhcPs (LHsExpr GhcPs)], Maybe SrcSpan)) }
+fbinds  :: { forall b. DisambECP b => PV ([AddAnn],([LHsRecField GhcPs (Located b)], Maybe SrcSpan)) }
         : fbinds1                       { $1 }
         : fbinds1                       { $1 }
-        | {- empty -}                   { ([],([], Nothing)) }
+        | {- empty -}                   { return ([],([], Nothing)) }
 
 
-fbinds1 :: { ([AddAnn],([LHsRecField GhcPs (LHsExpr GhcPs)], Maybe SrcSpan)) }
+fbinds1 :: { forall b. DisambECP b => PV ([AddAnn],([LHsRecField GhcPs (Located b)], Maybe SrcSpan)) }
         : fbind ',' fbinds1
         : fbind ',' fbinds1
-                {% addAnnotation (gl $1) AnnComma (gl $2) >>
+                 { $1 >>= \ $1 ->
+                   $3 >>= \ $3 ->
+                   addAnnotation (gl $1) AnnComma (gl $2) >>
                    return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) }
                    return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) }
-        | fbind                         { ([],([$1], Nothing)) }
-        | '..'                          { ([mj AnnDotdot $1],([],   Just (getLoc $1))) }
+        | fbind                         { $1 >>= \ $1 ->
+                                          return ([],([$1], Nothing)) }
+        | '..'                          { return ([mj AnnDotdot $1],([],   Just (getLoc $1))) }
 
 
-fbind   :: { LHsRecField GhcPs (LHsExpr GhcPs) }
-        : qvar '=' texp {% runExpCmdP $3 >>= \ $3 ->
+fbind   :: { forall b. DisambECP b => PV (LHsRecField GhcPs (Located b)) }
+        : qvar '=' texp  { runECP_PV $3 >>= \ $3 ->
                            ams  (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False)
                                 [mj AnnEqual $2] }
                         -- RHS is a 'texp', allowing view patterns (#6038)
                         -- and, incidentally, sections.  Eg
                         -- f (R { x = show -> s }) = ...
 
                            ams  (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False)
                                 [mj AnnEqual $2] }
                         -- RHS is a 'texp', allowing view patterns (#6038)
                         -- and, incidentally, sections.  Eg
                         -- f (R { x = show -> s }) = ...
 
-        | qvar          { sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) placeHolderPunRhs True }
+        | qvar          { placeHolderPunRhs >>= \rhs ->
+                          return $ sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) rhs True }
                         -- In the punning case, use a place-holder
                         -- The renamer fills in the final value
 
                         -- In the punning case, use a place-holder
                         -- The renamer fills in the final value
 
@@ -3291,7 +3311,7 @@ dbinds  :: { Located [LIPBind GhcPs] }
 --      | {- empty -}                  { [] }
 
 dbind   :: { LIPBind GhcPs }
 --      | {- empty -}                  { [] }
 
 dbind   :: { LIPBind GhcPs }
-dbind   : ipvar '=' exp                {% runExpCmdP $3 >>= \ $3 ->
+dbind   : ipvar '=' exp                {% runECP_P $3 >>= \ $3 ->
                                           ams (sLL $1 $> (IPBind noExt (Left $1) $3))
                                               [mj AnnEqual $2] }
 
                                           ams (sLL $1 $> (IPBind noExt (Left $1) $3))
                                               [mj AnnEqual $2] }
 
@@ -3505,18 +3525,18 @@ varop   :: { Located RdrName }
                                        [mj AnnBackquote $1,mj AnnVal $2
                                        ,mj AnnBackquote $3] }
 
                                        [mj AnnBackquote $1,mj AnnVal $2
                                        ,mj AnnBackquote $3] }
 
-qop     :: { LHsExpr GhcPs }   -- used in sections
-        : qvarop                { sL1 $1 $ HsVar noExt $1 }
-        | qconop                { sL1 $1 $ HsVar noExt $1 }
+qop     :: { forall b. DisambInfixOp b => PV (Located b) }   -- used in sections
+        : qvarop                { mkHsVarOpPV $1 }
+        | qconop                { mkHsConOpPV $1 }
         | hole_op               { $1 }
 
         | hole_op               { $1 }
 
-qopm    :: { LHsExpr GhcPs }   -- used in sections
-        : qvaropm               { sL1 $1 $ HsVar noExt $1 }
-        | qconop                { sL1 $1 $ HsVar noExt $1 }
+qopm    :: { forall b. DisambInfixOp b => PV (Located b) }   -- used in sections
+        : qvaropm               { mkHsVarOpPV $1 }
+        | qconop                { mkHsConOpPV $1 }
         | hole_op               { $1 }
 
         | hole_op               { $1 }
 
-hole_op :: { LHsExpr GhcPs }   -- used in sections
-hole_op : '`' '_' '`'           {% ams (sLL $1 $> $ EWildPat noExt)
+hole_op :: { forall b. DisambInfixOp b => PV (Located b) }   -- used in sections
+hole_op : '`' '_' '`'           { amms (mkHsInfixHolePV (comb2 $1 $>))
                                        [mj AnnBackquote $1,mj AnnVal $2
                                        ,mj AnnBackquote $3] }
 
                                        [mj AnnBackquote $1,mj AnnVal $2
                                        ,mj AnnBackquote $3] }
 
@@ -3943,12 +3963,8 @@ hintExplicitForall tok = do
   where
     forallSymDoc = text (forallSym (isUnicode tok))
 
   where
     forallSymDoc = text (forallSym (isUnicode tok))
 
-checkIfBang :: LHsExpr GhcPs -> Bool
-checkIfBang (dL->L _ (HsVar _ (dL->L _ op))) = op == bang_RDR
-checkIfBang _ = False
-
 -- | Warn about missing space after bang
 -- | Warn about missing space after bang
-warnSpaceAfterBang :: SrcSpan -> P ()
+warnSpaceAfterBang :: SrcSpan -> PV ()
 warnSpaceAfterBang span = do
     bang_on <- getBit BangPatBit
     unless bang_on $
 warnSpaceAfterBang span = do
     bang_on <- getBit BangPatBit
     unless bang_on $
@@ -4048,7 +4064,7 @@ ajs a@(Just (dL->L l _)) bs = addAnnsAt l bs >> return a
 
 -- |Add a list of AddAnns to the given AST element, where the AST element is the
 --  result of a monadic action
 
 -- |Add a list of AddAnns to the given AST element, where the AST element is the
 --  result of a monadic action
-amms :: HasSrcSpan a => P a -> [AddAnn] -> P a
+amms :: MonadP m => HasSrcSpan a => m a -> [AddAnn] -> m a
 amms a bs = do { av@(dL->L l _) <- a
                ; addAnnsAt l bs
                ; return av }
 amms a bs = do { av@(dL->L l _) <- a
                ; addAnnsAt l bs
                ; return av }
index f4b909b..8d15cb3 100644 (file)
@@ -13,8 +13,6 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module   RdrHsSyn (
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module   RdrHsSyn (
@@ -51,11 +49,11 @@ module   RdrHsSyn (
 
         -- Bunch of functions in the parser monad for
         -- checking and constructing values
 
         -- Bunch of functions in the parser monad for
         -- checking and constructing values
+        checkExpBlockArguments,
         checkPrecP,           -- Int -> P Int
         checkContext,         -- HsType -> P HsContext
         checkPattern,         -- HsExp -> P HsPat
         checkPattern_msg,
         checkPrecP,           -- Int -> P Int
         checkContext,         -- HsType -> P HsContext
         checkPattern,         -- HsExp -> P HsPat
         checkPattern_msg,
-        bang_RDR,
         isBangRdr,
         isTildeRdr,
         checkMonadComp,       -- P (HsStmtContext RdrName)
         isBangRdr,
         isTildeRdr,
         checkMonadComp,       -- P (HsStmtContext RdrName)
@@ -85,16 +83,19 @@ module   RdrHsSyn (
         warnStarIsType,
         failOpFewArgs,
 
         warnStarIsType,
         failOpFewArgs,
 
-        SumOrTuple (..), mkSumOrTuple,
+        SumOrTuple (..),
 
 
-        -- Expression/command ambiguity resolution
+        -- Expression/command/pattern ambiguity resolution
         PV,
         runPV,
         PV,
         runPV,
-        ExpCmdP(ExpCmdP, runExpCmdPV),
-        runExpCmdP,
-        ExpCmdI(..),
-        ecFromExp,
-        ecFromCmd,
+        ECP(ECP, runECP_PV),
+        runECP_P,
+        DisambInfixOp(..),
+        DisambECP(..),
+        ecpFromExp,
+        ecpFromCmd,
+        PatBuilder,
+        patBuilderBang,
 
     ) where
 
 
     ) where
 
@@ -911,7 +912,7 @@ checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName)
                                     ++ occNameString occ))
         check _ = panic "checkRuleTyVarBndrNames"
 
                                     ++ occNameString occ))
         check _ = panic "checkRuleTyVarBndrNames"
 
-checkRecordSyntax :: Outputable a => Located a -> P (Located a)
+checkRecordSyntax :: (MonadP m, Outputable a) => Located a -> m (Located a)
 checkRecordSyntax lr@(dL->L loc r)
     = do allowed <- getBit TraditionalRecordSyntaxBit
          unless allowed $ addError loc $
 checkRecordSyntax lr@(dL->L loc r)
     = do allowed <- getBit TraditionalRecordSyntaxBit
          unless allowed $ addError loc $
@@ -1056,117 +1057,80 @@ checkNoDocs msg ty = go ty
 -- We parse patterns as expressions and check for valid patterns below,
 -- converting the expression into a pattern at the same time.
 
 -- We parse patterns as expressions and check for valid patterns below,
 -- converting the expression into a pattern at the same time.
 
-checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs)
+checkPattern :: Located (PatBuilder GhcPs) -> P (LPat GhcPs)
 checkPattern = runPV . checkLPat
 
 checkPattern = runPV . checkLPat
 
-checkPattern_msg :: SDoc -> LHsExpr GhcPs -> P (LPat GhcPs)
-checkPattern_msg msg = runPV_msg msg . checkLPat
+checkPattern_msg :: SDoc -> PV (Located (PatBuilder GhcPs)) -> P (LPat GhcPs)
+checkPattern_msg msg pp = runPV_msg msg (pp >>= checkLPat)
 
 
-checkLPat :: LHsExpr GhcPs -> PV (LPat GhcPs)
+checkLPat :: Located (PatBuilder GhcPs) -> PV (LPat GhcPs)
 checkLPat e@(dL->L l _) = checkPat l e []
 
 checkLPat e@(dL->L l _) = checkPat l e []
 
-checkPat :: SrcSpan -> LHsExpr GhcPs -> [LPat GhcPs]
+checkPat :: SrcSpan -> Located (PatBuilder GhcPs) -> [LPat GhcPs]
          -> PV (LPat GhcPs)
          -> PV (LPat GhcPs)
-checkPat loc (dL->L l e@(HsVar _ (dL->L _ c))) args
+checkPat loc (dL->L l e@(PatBuilderVar (dL->L _ c))) args
   | isRdrDataCon c = return (cL loc (ConPatIn (cL l c) (PrefixCon args)))
   | not (null args) && patIsRec c =
       localPV_msg (\_ -> text "Perhaps you intended to use RecursiveDo") $
   | isRdrDataCon c = return (cL loc (ConPatIn (cL l c) (PrefixCon args)))
   | not (null args) && patIsRec c =
       localPV_msg (\_ -> text "Perhaps you intended to use RecursiveDo") $
-      patFail l e
+      patFail l (ppr e)
 checkPat loc e args     -- OK to let this happen even if bang-patterns
                         -- are not enabled, because there is no valid
                         -- non-bang-pattern parse of (C ! e)
   | Just (e', args') <- splitBang e
   = do  { args'' <- mapM checkLPat args'
         ; checkPat loc e' (args'' ++ args) }
 checkPat loc e args     -- OK to let this happen even if bang-patterns
                         -- are not enabled, because there is no valid
                         -- non-bang-pattern parse of (C ! e)
   | Just (e', args') <- splitBang e
   = do  { args'' <- mapM checkLPat args'
         ; checkPat loc e' (args'' ++ args) }
-checkPat loc (dL->L _ (HsApp _ f e)) args
+checkPat loc (dL->L _ (PatBuilderApp f e)) args
   = do p <- checkLPat e
        checkPat loc f (p : args)
 checkPat loc (dL->L _ e) []
   = do p <- checkAPat loc e
        return (cL loc p)
 checkPat loc e _
   = do p <- checkLPat e
        checkPat loc f (p : args)
 checkPat loc (dL->L _ e) []
   = do p <- checkAPat loc e
        return (cL loc p)
 checkPat loc e _
-  = patFail loc (unLoc e)
+  = patFail loc (ppr e)
 
 
-checkAPat :: SrcSpan -> HsExpr GhcPs -> PV (Pat GhcPs)
+checkAPat :: SrcSpan -> PatBuilder GhcPs -> PV (Pat GhcPs)
 checkAPat loc e0 = do
  nPlusKPatterns <- getBit NPlusKPatternsBit
  case e0 of
 checkAPat loc e0 = do
  nPlusKPatterns <- getBit NPlusKPatternsBit
  case e0 of
-   EWildPat _ -> return (WildPat noExt)
-   HsVar _ x  -> return (VarPat noExt x)
-   HsLit _ (HsStringPrim _ _) -- (#13260)
-       -> addFatalError loc (text "Illegal unboxed string literal in pattern:"
-                              $$ ppr e0)
-
-   HsLit _ l  -> return (LitPat noExt l)
+   PatBuilderPat p -> return p
+   PatBuilderVar x -> return (VarPat noExt x)
 
    -- Overloaded numeric patterns (e.g. f 0 x = x)
    -- Negation is recorded separately, so that the literal is zero or +ve
    -- NB. Negative *primitive* literals are already handled by the lexer
 
    -- Overloaded numeric patterns (e.g. f 0 x = x)
    -- Negation is recorded separately, so that the literal is zero or +ve
    -- NB. Negative *primitive* literals are already handled by the lexer
-   HsOverLit _ pos_lit          -> return (mkNPat (cL loc pos_lit) Nothing)
-   NegApp _ (dL->L l (HsOverLit _ pos_lit)) _
-                        -> return (mkNPat (cL l pos_lit) (Just noSyntaxExpr))
+   PatBuilderOverLit pos_lit -> return (mkNPat (cL loc pos_lit) Nothing)
 
 
-   SectionR _ (dL->L lb (HsVar _ (dL->L _ bang))) e    -- (! x)
-        | bang == bang_RDR
+   PatBuilderBang lb e   -- (! x)
         -> do { hintBangPat loc e0
               ; e' <- checkLPat e
               ; addAnnotation loc AnnBang lb
               ; return  (BangPat noExt e') }
 
         -> do { hintBangPat loc e0
               ; e' <- checkLPat e
               ; addAnnotation loc AnnBang lb
               ; return  (BangPat noExt e') }
 
-   ELazyPat _ e         -> checkLPat e >>= (return . (LazyPat noExt))
-   EAsPat _ n e         -> checkLPat e >>= (return . (AsPat noExt) n)
-   -- view pattern is well-formed if the pattern is
-   EViewPat _ expr patE -> checkLPat patE >>=
-                            (return . (\p -> ViewPat noExt expr p))
-   ExprWithTySig _ e t  -> do e <- checkLPat e
-                              return (SigPat noExt e t)
-
    -- n+k patterns
    -- n+k patterns
-   OpApp _ (dL->L nloc (HsVar _ (dL->L _ n)))
-           (dL->L _    (HsVar _ (dL->L _ plus)))
-           (dL->L lloc (HsOverLit _ lit@(OverLit {ol_val = HsIntegral {}})))
+   PatBuilderOpApp
+           (dL->L nloc (PatBuilderVar (dL->L _ n)))
+           (dL->L _ plus)
+           (dL->L lloc (PatBuilderOverLit lit@(OverLit {ol_val = HsIntegral {}})))
                       | nPlusKPatterns && (plus == plus_RDR)
                       -> return (mkNPlusKPat (cL nloc n) (cL lloc lit))
                       | nPlusKPatterns && (plus == plus_RDR)
                       -> return (mkNPlusKPat (cL nloc n) (cL lloc lit))
-   OpApp _ l (dL->L cl (HsVar _ (dL->L _ c))) r
-     | isDataOcc (rdrNameOcc c) -> do
+
+   PatBuilderOpApp l (dL->L cl c) r
+     | isRdrDataCon c -> do
          l <- checkLPat l
          r <- checkLPat r
          return (ConPatIn (cL cl c) (InfixCon l r))
 
          l <- checkLPat l
          r <- checkLPat r
          return (ConPatIn (cL cl c) (InfixCon l r))
 
-   OpApp {}           -> patFail loc e0
-
-   ExplicitList _ _ es -> do ps <- mapM checkLPat es
-                             return (ListPat noExt ps)
-
-   HsPar _ e          -> checkLPat e >>= (return . (ParPat noExt))
-
-   ExplicitTuple _ es b
-     | all tupArgPresent es  -> do ps <- mapM checkLPat
-                                           [e | (dL->L _ (Present _ e)) <- es]
-                                   return (TuplePat noExt ps b)
-     | otherwise -> addFatalError loc (text "Illegal tuple section in pattern:"
-                                        $$ ppr e0)
-
-   ExplicitSum _ alt arity expr -> do
-     p <- checkLPat expr
-     return (SumPat noExt p alt arity)
-
-   RecordCon { rcon_con_name = c, rcon_flds = HsRecFields fs dd }
-                        -> do fs <- mapM checkPatField fs
-                              return (ConPatIn c (RecCon (HsRecFields fs dd)))
-   HsSpliceE _ s | not (isTypedSplice s)
-               -> return (SplicePat noExt s)
-   _           -> patFail loc e0
+   PatBuilderPar e    -> checkLPat e >>= (return . (ParPat noExt))
+   _           -> patFail loc (ppr e0)
 
 
-placeHolderPunRhs :: LHsExpr GhcPs
+placeHolderPunRhs :: DisambECP b => PV (Located b)
 -- The RHS of a punned record field will be filled in by the renamer
 -- It's better not to make it an error, in case we want to print it when
 -- debugging
 -- The RHS of a punned record field will be filled in by the renamer
 -- It's better not to make it an error, in case we want to print it when
 -- debugging
-placeHolderPunRhs = noLoc (HsVar noExt (noLoc pun_RDR))
+placeHolderPunRhs = mkHsVarPV (noLoc pun_RDR)
 
 
-plus_RDR, bang_RDR, pun_RDR :: RdrName
+plus_RDR, pun_RDR :: RdrName
 plus_RDR = mkUnqual varName (fsLit "+") -- Hack
 plus_RDR = mkUnqual varName (fsLit "+") -- Hack
-bang_RDR = mkUnqual varName (fsLit "!") -- Hack
 pun_RDR  = mkUnqual varName (fsLit "pun-right-hand-side")
 
 isBangRdr, isTildeRdr :: RdrName -> Bool
 pun_RDR  = mkUnqual varName (fsLit "pun-right-hand-side")
 
 isBangRdr, isTildeRdr :: RdrName -> Bool
@@ -1174,31 +1138,30 @@ isBangRdr (Unqual occ) = occNameFS occ == fsLit "!"
 isBangRdr _ = False
 isTildeRdr = (==eqTyCon_RDR)
 
 isBangRdr _ = False
 isTildeRdr = (==eqTyCon_RDR)
 
-checkPatField :: LHsRecField GhcPs (LHsExpr GhcPs)
+checkPatField :: LHsRecField GhcPs (Located (PatBuilder GhcPs))
               -> PV (LHsRecField GhcPs (LPat GhcPs))
 checkPatField (dL->L l fld) = do p <- checkLPat (hsRecFieldArg fld)
                                  return (cL l (fld { hsRecFieldArg = p }))
 
               -> PV (LHsRecField GhcPs (LPat GhcPs))
 checkPatField (dL->L l fld) = do p <- checkLPat (hsRecFieldArg fld)
                                  return (cL l (fld { hsRecFieldArg = p }))
 
-patFail :: SrcSpan -> HsExpr GhcPs -> PV a
+patFail :: SrcSpan -> SDoc -> PV a
 patFail loc e = addFatalError loc $ text "Parse error in pattern:" <+> ppr e
 
 patIsRec :: RdrName -> Bool
 patIsRec e = e == mkUnqual varName (fsLit "rec")
 
 patFail loc e = addFatalError loc $ text "Parse error in pattern:" <+> ppr e
 
 patIsRec :: RdrName -> Bool
 patIsRec e = e == mkUnqual varName (fsLit "rec")
 
-
 ---------------------------------------------------------------------------
 -- Check Equation Syntax
 
 checkValDef :: SrcStrictness
 ---------------------------------------------------------------------------
 -- Check Equation Syntax
 
 checkValDef :: SrcStrictness
-            -> LHsExpr GhcPs
+            -> Located (PatBuilder GhcPs)
             -> Maybe (LHsType GhcPs)
             -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
             -> P ([AddAnn],HsBind GhcPs)
 
 checkValDef _strictness lhs (Just sig) grhss
         -- x :: ty = rhs  parses as a *pattern* binding
             -> Maybe (LHsType GhcPs)
             -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
             -> P ([AddAnn],HsBind GhcPs)
 
 checkValDef _strictness lhs (Just sig) grhss
         -- x :: ty = rhs  parses as a *pattern* binding
-  = checkPatBind (cL (combineLocs lhs sig)
-                        (ExprWithTySig noExt lhs (mkLHsSigWcType sig))) grhss
+  = do lhs' <- runPV $ mkHsTySigPV (combineLocs lhs sig) lhs sig >>= checkLPat
+       checkPatBind lhs' grhss
 
 checkValDef strictness lhs Nothing g@(dL->L l (_,grhss))
   = do  { mb_fun <- isFunLhs lhs
 
 checkValDef strictness lhs Nothing g@(dL->L l (_,grhss))
   = do  { mb_fun <- isFunLhs lhs
@@ -1206,14 +1169,16 @@ checkValDef strictness lhs Nothing g@(dL->L l (_,grhss))
             Just (fun, is_infix, pats, ann) ->
               checkFunBind strictness ann (getLoc lhs)
                            fun is_infix pats (cL l grhss)
             Just (fun, is_infix, pats, ann) ->
               checkFunBind strictness ann (getLoc lhs)
                            fun is_infix pats (cL l grhss)
-            Nothing -> checkPatBind lhs g }
+            Nothing -> do
+              lhs' <- checkPattern lhs
+              checkPatBind lhs' g }
 
 checkFunBind :: SrcStrictness
              -> [AddAnn]
              -> SrcSpan
              -> Located RdrName
              -> LexicalFixity
 
 checkFunBind :: SrcStrictness
              -> [AddAnn]
              -> SrcSpan
              -> Located RdrName
              -> LexicalFixity
-             -> [LHsExpr GhcPs]
+             -> [Located (PatBuilder GhcPs)]
              -> Located (GRHSs GhcPs (LHsExpr GhcPs))
              -> P ([AddAnn],HsBind GhcPs)
 checkFunBind strictness ann lhs_loc fun is_infix pats (dL->L rhs_span grhss)
              -> Located (GRHSs GhcPs (LHsExpr GhcPs))
              -> P ([AddAnn],HsBind GhcPs)
 checkFunBind strictness ann lhs_loc fun is_infix pats (dL->L rhs_span grhss)
@@ -1242,13 +1207,11 @@ makeFunBind fn ms
               fun_co_fn = idHsWrapper,
               fun_tick = [] }
 
               fun_co_fn = idHsWrapper,
               fun_tick = [] }
 
-checkPatBind :: LHsExpr GhcPs
+checkPatBind :: LPat GhcPs
              -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
              -> P ([AddAnn],HsBind GhcPs)
 checkPatBind lhs (dL->L _ (_,grhss))
              -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
              -> P ([AddAnn],HsBind GhcPs)
 checkPatBind lhs (dL->L _ (_,grhss))
-  = do  { lhs <- checkPattern lhs
-        ; return ([],PatBind noExt lhs grhss
-                    ([],[])) }
+  = return ([],PatBind noExt lhs grhss ([],[]))
 
 checkValSigLhs :: LHsExpr GhcPs -> P (Located RdrName)
 checkValSigLhs (dL->L _ (HsVar _ lrdr@(dL->L _ v)))
 
 checkValSigLhs :: LHsExpr GhcPs -> P (Located RdrName)
 checkValSigLhs (dL->L _ (HsVar _ lrdr@(dL->L _ v)))
@@ -1282,10 +1245,10 @@ checkValSigLhs lhs@(dL->L l _)
     default_RDR = mkUnqual varName (fsLit "default")
     pattern_RDR = mkUnqual varName (fsLit "pattern")
 
     default_RDR = mkUnqual varName (fsLit "default")
     pattern_RDR = mkUnqual varName (fsLit "pattern")
 
-checkDoAndIfThenElse'
+checkDoAndIfThenElse
   :: (HasSrcSpan a, Outputable a, Outputable b, HasSrcSpan c, Outputable c)
   => a -> Bool -> b -> Bool -> c -> PV ()
   :: (HasSrcSpan a, Outputable a, Outputable b, HasSrcSpan c, Outputable c)
   => a -> Bool -> b -> Bool -> c -> PV ()
-checkDoAndIfThenElse' guardExpr semiThen thenExpr semiElse elseExpr
+checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
  | semiThen || semiElse
     = do doAndIfThenElse <- getBit DoAndIfThenElseBit
          unless doAndIfThenElse $ do
  | semiThen || semiElse
     = do doAndIfThenElse <- getBit DoAndIfThenElseBit
          unless doAndIfThenElse $ do
@@ -1303,20 +1266,21 @@ checkDoAndIfThenElse' guardExpr semiThen thenExpr semiElse elseExpr
 
         -- The parser left-associates, so there should
         -- not be any OpApps inside the e's
 
         -- The parser left-associates, so there should
         -- not be any OpApps inside the e's
-splitBang :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs, [LHsExpr GhcPs])
+splitBang :: Located (PatBuilder GhcPs) -> Maybe (Located (PatBuilder GhcPs), [Located (PatBuilder GhcPs)])
 -- Splits (f ! g a b) into (f, [(! g), a, b])
 -- Splits (f ! g a b) into (f, [(! g), a, b])
-splitBang (dL->L _ (OpApp _ l_arg bang@(dL->L _ (HsVar _ (dL->L _ op))) r_arg))
-  | op == bang_RDR = Just (l_arg, cL l' (SectionR noExt bang arg1) : argns)
+splitBang (dL->L _ (PatBuilderOpApp l_arg op r_arg))
+  | isBangRdr (unLoc op)
+  = Just (l_arg, cL l' (PatBuilderBang (getLoc op) arg1) : argns)
   where
   where
-    l' = combineLocs bang arg1
+    l' = combineLocs op arg1
     (arg1,argns) = split_bang r_arg []
     (arg1,argns) = split_bang r_arg []
-    split_bang (dL->L _ (HsApp _ f e)) es = split_bang f (e:es)
+    split_bang (dL->L _ (PatBuilderApp f e)) es = split_bang f (e:es)
     split_bang e                       es = (e,es)
 splitBang _ = Nothing
 
 -- See Note [isFunLhs vs mergeDataCon]
     split_bang e                       es = (e,es)
 splitBang _ = Nothing
 
 -- See Note [isFunLhs vs mergeDataCon]
-isFunLhs :: LHsExpr GhcPs
-      -> P (Maybe (Located RdrName, LexicalFixity, [LHsExpr GhcPs],[AddAnn]))
+isFunLhs :: Located (PatBuilder GhcPs)
+      -> P (Maybe (Located RdrName, LexicalFixity, [Located (PatBuilder GhcPs)],[AddAnn]))
 -- A variable binding is parsed as a FunBind.
 -- Just (fun, is_infix, arg_pats) if e is a function LHS
 --
 -- A variable binding is parsed as a FunBind.
 -- Just (fun, is_infix, arg_pats) if e is a function LHS
 --
@@ -1331,17 +1295,15 @@ isFunLhs :: LHsExpr GhcPs
 
 isFunLhs e = go e [] []
  where
 
 isFunLhs e = go e [] []
  where
-   go (dL->L loc (HsVar _ (dL->L _ f))) es ann
+   go (dL->L loc (PatBuilderVar (dL->L _ f))) es ann
        | not (isRdrDataCon f)        = return (Just (cL loc f, Prefix, es, ann))
        | not (isRdrDataCon f)        = return (Just (cL loc f, Prefix, es, ann))
-   go (dL->L _ (HsApp _ f e)) es       ann = go f (e:es) ann
-   go (dL->L l (HsPar _ e))   es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)
+   go (dL->L _ (PatBuilderApp f e)) es       ann = go f (e:es) ann
+   go (dL->L l (PatBuilderPar e))   es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)
 
         -- Things of the form `!x` are also FunBinds
         -- See Note [FunBind vs PatBind]
 
         -- Things of the form `!x` are also FunBinds
         -- See Note [FunBind vs PatBind]
-   go (dL->L _ (SectionR _ (dL->L _ (HsVar _ (dL->L _ bang)))
-                (dL->L l (HsVar _ (L _ var))))) [] ann
-        | bang == bang_RDR
-        , not (isRdrDataCon var)     = return (Just (cL l var, Prefix, [], ann))
+   go (dL->L _ (PatBuilderBang _ (L _ (PatBuilderVar (dL -> L l var))))) [] ann
+        | not (isRdrDataCon var)     = return (Just (cL l var, Prefix, [], ann))
 
       -- For infix function defns, there should be only one infix *function*
       -- (though there may be infix *datacons* involved too).  So we don't
 
       -- For infix function defns, there should be only one infix *function*
       -- (though there may be infix *datacons* involved too).  So we don't
@@ -1356,7 +1318,7 @@ isFunLhs e = go e [] []
       -- ToDo: what about this?
       --              x + 1 `op` y = ...
 
       -- ToDo: what about this?
       --              x + 1 `op` y = ...
 
-   go e@(L loc (OpApp _ l (dL->L loc' (HsVar _ (dL->L _ op))) r)) es ann
+   go e@(L loc (PatBuilderOpApp l (dL->L loc' op) r)) es ann
         | Just (e',es') <- splitBang e
         = do { bang_on <- getBit BangPatBit
              ; if bang_on then go e' (es' ++ es) ann
         | Just (e',es') <- splitBang e
         = do { bang_on <- getBit BangPatBit
              ; if bang_on then go e' (es' ++ es) ann
@@ -1370,8 +1332,8 @@ isFunLhs e = go e [] []
                  Just (op', Infix, j : k : es', ann')
                    -> return (Just (op', Infix, j : op_app : es', ann'))
                    where
                  Just (op', Infix, j : k : es', ann')
                    -> return (Just (op', Infix, j : op_app : es', ann'))
                    where
-                     op_app = cL loc (OpApp noExt k
-                               (cL loc' (HsVar noExt (cL loc' op))) r)
+                     op_app = cL loc (PatBuilderOpApp k
+                               (cL loc' op) r)
                  _ -> return Nothing }
    go _ _ _ = return Nothing
 
                  _ -> return Nothing }
    go _ _ _ = return Nothing
 
@@ -1856,7 +1818,7 @@ mergeDataCon all_xs =
 -- If the flag MonadComprehensions is set, return a 'MonadComp' context,
 -- otherwise use the usual 'ListComp' context
 
 -- If the flag MonadComprehensions is set, return a 'MonadComp' context,
 -- otherwise use the usual 'ListComp' context
 
-checkMonadComp :: P (HsStmtContext Name)
+checkMonadComp :: PV (HsStmtContext Name)
 checkMonadComp = do
     monadComprehensions <- getBit MonadComprehensionsBit
     return $ if monadComprehensions
 checkMonadComp = do
     monadComprehensions <- getBit MonadComprehensionsBit
     return $ if monadComprehensions
@@ -1864,96 +1826,373 @@ checkMonadComp = do
                 else ListComp
 
 -- -------------------------------------------------------------------------
                 else ListComp
 
 -- -------------------------------------------------------------------------
--- Expression/command ambiguity (arrow syntax).
+-- Expression/command/pattern ambiguity.
 -- See Note [Ambiguous syntactic categories]
 --
 
 -- See Note [Ambiguous syntactic categories]
 --
 
--- ExpCmdP as defined is isomorphic to a pair of parsers:
---
---   data ExpCmdP = ExpCmdP { expP :: PV (LHsExpr GhcPs)
---                          , cmdP :: PV (LHsCmd  GhcPs) }
---
 -- See Note [Parser-Validator]
 -- See Note [Ambiguous syntactic categories]
 -- See Note [Parser-Validator]
 -- See Note [Ambiguous syntactic categories]
-newtype ExpCmdP =
-  ExpCmdP { runExpCmdPV :: forall b. ExpCmdI b => PV (Located (b GhcPs)) }
+newtype ECP =
+  ECP { runECP_PV :: forall b. DisambECP b => PV (Located b) }
 
 
-runExpCmdP :: ExpCmdI b => ExpCmdP -> P (Located (b GhcPs))
-runExpCmdP p = runPV (runExpCmdPV p)
+runECP_P :: DisambECP b => ECP -> P (Located b)
+runECP_P p = runPV (runECP_PV p)
 
 
-ecFromExp :: LHsExpr GhcPs -> ExpCmdP
-ecFromExp a = ExpCmdP (ecFromExp' a)
+ecpFromExp :: LHsExpr GhcPs -> ECP
+ecpFromExp a = ECP (ecpFromExp' a)
 
 
-ecFromCmd :: LHsCmd GhcPs -> ExpCmdP
-ecFromCmd a = ExpCmdP (ecFromCmd' a)
+ecpFromCmd :: LHsCmd GhcPs -> ECP
+ecpFromCmd a = ECP (ecpFromCmd' a)
 
 
+-- | Disambiguate infix operators.
+-- See Note [Ambiguous syntactic categories]
+class DisambInfixOp b where
+  checkIfBang :: b -> Bool
+  mkHsVarOpPV :: Located RdrName -> PV (Located b)
+  mkHsConOpPV :: Located RdrName -> PV (Located b)
+  mkHsInfixHolePV :: SrcSpan -> PV (Located b)
+
+instance p ~ GhcPs => DisambInfixOp (HsExpr p) where
+  checkIfBang (HsVar _ (unLoc -> op)) = isBangRdr op
+  checkIfBang _ = False
+  mkHsVarOpPV v = return $ cL (getLoc v) (HsVar noExt v)
+  mkHsConOpPV v = return $ cL (getLoc v) (HsVar noExt v)
+  mkHsInfixHolePV l = return $ cL l hsHoleExpr
+
+instance DisambInfixOp RdrName where
+  checkIfBang = isBangRdr
+  mkHsConOpPV (dL->L l v) = return $ cL l v
+  mkHsVarOpPV (dL->L l v) = return $ cL l v
+  mkHsInfixHolePV l =
+    addFatalError l $ text "Invalid infix hole, expected an infix operator"
+
+-- | Disambiguate constructs that may appear when we do not know ahead of time whether we are
+-- parsing an expression, a command, or a pattern.
 -- See Note [Ambiguous syntactic categories]
 -- See Note [Ambiguous syntactic categories]
-class ExpCmdI b where
+class b ~ (Body b) GhcPs => DisambECP b where
+  -- | See Note [Body in DisambECP]
+  type Body b :: * -> *
   -- | Return a command without ambiguity, or fail in a non-command context.
   -- | Return a command without ambiguity, or fail in a non-command context.
-  ecFromCmd' :: LHsCmd GhcPs -> PV (Located (b GhcPs))
+  ecpFromCmd' :: LHsCmd GhcPs -> PV (Located b)
   -- | Return an expression without ambiguity, or fail in a non-expression context.
   -- | Return an expression without ambiguity, or fail in a non-expression context.
-  ecFromExp' :: LHsExpr GhcPs -> PV (Located (b GhcPs))
+  ecpFromExp' :: LHsExpr GhcPs -> PV (Located b)
   -- | Disambiguate "\... -> ..." (lambda)
   -- | Disambiguate "\... -> ..." (lambda)
-  ecHsLam :: MatchGroup GhcPs (Located (b GhcPs)) -> b GhcPs
+  mkHsLamPV :: SrcSpan -> MatchGroup GhcPs (Located b) -> PV (Located b)
   -- | Disambiguate "let ... in ..."
   -- | Disambiguate "let ... in ..."
-  ecHsLet :: LHsLocalBinds GhcPs -> Located (b GhcPs) -> b GhcPs
+  mkHsLetPV :: SrcSpan -> LHsLocalBinds GhcPs -> Located b -> PV (Located b)
+  -- | Infix operator representation
+  type InfixOp b
+  -- | Bring superclass constraints on FunArg into scope.
+  -- See Note [UndecidableSuperClasses for associated types]
+  superInfixOp :: (DisambInfixOp (InfixOp b) => PV (Located b )) -> PV (Located b)
   -- | Disambiguate "f # x" (infix operator)
   -- | Disambiguate "f # x" (infix operator)
-  ecOpApp :: Located (b GhcPs) -> LHsExpr GhcPs -> Located (b GhcPs) -> b GhcPs
+  mkHsOpAppPV :: SrcSpan -> Located b -> Located (InfixOp b) -> Located b -> PV (Located b)
   -- | Disambiguate "case ... of ..."
   -- | Disambiguate "case ... of ..."
-  ecHsCase :: LHsExpr GhcPs -> MatchGroup GhcPs (Located (b GhcPs)) -> b GhcPs
+  mkHsCasePV :: SrcSpan -> LHsExpr GhcPs -> MatchGroup GhcPs (Located b) -> PV (Located b)
+  -- | Function argument representation
+  type FunArg b
+  -- | Bring superclass constraints on FunArg into scope.
+  -- See Note [UndecidableSuperClasses for associated types]
+  superFunArg :: (DisambECP (FunArg b) => PV (Located b)) -> PV (Located b)
   -- | Disambiguate "f x" (function application)
   -- | Disambiguate "f x" (function application)
-  ecHsApp :: Located (b GhcPs) -> LHsExpr GhcPs -> b GhcPs
+  mkHsAppPV :: SrcSpan -> Located b -> Located (FunArg b) -> PV (Located b)
   -- | Disambiguate "if ... then ... else ..."
   -- | Disambiguate "if ... then ... else ..."
-  ecHsIf :: LHsExpr GhcPs -> Located (b GhcPs) -> Located (b GhcPs) -> b GhcPs
+  mkHsIfPV :: SrcSpan
+         -> LHsExpr GhcPs
+         -> Bool  -- semicolon?
+         -> Located b
+         -> Bool  -- semicolon?
+         -> Located b
+         -> PV (Located b)
   -- | Disambiguate "do { ... }" (do notation)
   -- | Disambiguate "do { ... }" (do notation)
-  ecHsDo :: Located [LStmt GhcPs (Located (b GhcPs))] -> b GhcPs
+  mkHsDoPV :: SrcSpan -> Located [LStmt GhcPs (Located b)] -> PV (Located b)
   -- | Disambiguate "( ... )" (parentheses)
   -- | Disambiguate "( ... )" (parentheses)
-  ecHsPar :: Located (b GhcPs) -> b GhcPs
-  -- | Check if the argument requires -XBlockArguments.
-  checkBlockArguments :: Located (b GhcPs) -> PV ()
-  -- | Check if -XDoAndIfThenElse is enabled.
-  checkDoAndIfThenElse :: LHsExpr GhcPs -> Bool -> Located (b GhcPs)
-                                        -> Bool -> Located (b GhcPs) -> PV ()
-
-instance ExpCmdI HsCmd where
-  ecFromCmd' = return
-  ecFromExp' (dL-> L l e) =
-    addFatalError l $
-      text "Parse error in command:" <+> ppr e
-  ecHsLam = HsCmdLam noExt
-  ecHsLet = HsCmdLet noExt
-  ecOpApp c1 op c2 =
-      let cmdArg c = cL (getLoc c) $ HsCmdTop noExt c in
-      HsCmdArrForm noExt op Infix Nothing [cmdArg c1, cmdArg c2]
-  ecHsCase = HsCmdCase noExt
-  ecHsApp = HsCmdApp noExt
-  ecHsIf = mkHsCmdIf
-  ecHsDo = HsCmdDo noExt
-  ecHsPar = HsCmdPar noExt
-  checkBlockArguments = checkCmdBlockArguments
-  checkDoAndIfThenElse = checkDoAndIfThenElse'
-
-instance ExpCmdI HsExpr where
-  ecFromCmd' (dL -> L l c) = do
+  mkHsParPV :: SrcSpan -> Located b -> PV (Located b)
+  -- | Disambiguate a variable "f" or a data constructor "MkF".
+  mkHsVarPV :: Located RdrName -> PV (Located b)
+  -- | Disambiguate a monomorphic literal
+  mkHsLitPV :: Located (HsLit GhcPs) -> PV (Located b)
+  -- | Disambiguate an overloaded literal
+  mkHsOverLitPV :: Located (HsOverLit GhcPs) -> PV (Located b)
+  -- | Disambiguate a wildcard
+  mkHsWildCardPV :: SrcSpan -> PV (Located b)
+  -- | Disambiguate "a :: t" (type annotation)
+  mkHsTySigPV :: SrcSpan -> Located b -> LHsType GhcPs -> PV (Located b)
+  -- | Disambiguate "[a,b,c]" (list syntax)
+  mkHsExplicitListPV :: SrcSpan -> [Located b] -> PV (Located b)
+  -- | Disambiguate "$(...)" and "[quasi|...|]" (TH splices)
+  mkHsSplicePV :: Located (HsSplice GhcPs) -> PV (Located b)
+  -- | Disambiguate "f { a = b, ... }" syntax (record construction and record updates)
+  mkHsRecordPV ::
+    SrcSpan ->
+    SrcSpan ->
+    Located b ->
+    ([LHsRecField GhcPs (Located b)], Maybe SrcSpan) ->
+    PV (Located b)
+  -- | Disambiguate "-a" (negation)
+  mkHsNegAppPV :: SrcSpan -> Located b -> PV (Located b)
+  -- | Disambiguate "(# a)" (right operator section)
+  mkHsSectionR_PV :: SrcSpan -> Located (InfixOp b) -> Located b -> PV (Located b)
+  -- | Disambiguate "(a -> b)" (view pattern)
+  mkHsViewPatPV :: SrcSpan -> LHsExpr GhcPs -> Located b -> PV (Located b)
+  -- | Disambiguate "a@b" (as-pattern)
+  mkHsAsPatPV :: SrcSpan -> Located RdrName -> Located b -> PV (Located b)
+  -- | Disambiguate "~a" (lazy pattern)
+  mkHsLazyPatPV :: SrcSpan -> Located b -> PV (Located b)
+  -- | Disambiguate tuple sections and unboxed sums
+  mkSumOrTuplePV :: SrcSpan -> Boxity -> SumOrTuple b -> PV (Located b)
+
+{- Note [UndecidableSuperClasses for associated types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Assume we have a class C with an associated type T:
+
+  class C a where
+    type T a
+    ...
+
+If we want to add 'C (T a)' as a superclass, we need -XUndecidableSuperClasses:
+
+  {-# LANGUAGE UndecidableSuperClasses #-}
+  class C (T a) => C a where
+    type T a
+    ...
+
+Unfortunately, -XUndecidableSuperClasses don't work all that well, sometimes
+making GHC loop. The workaround is to bring this constraint into scope
+manually with a helper method:
+
+  class C a where
+    type T a
+    superT :: (C (T a) => r) -> r
+
+In order to avoid ambiguous types, 'r' must mention 'a'.
+
+For consistency, we use this approach for all constraints on associated types,
+even when -XUndecidableSuperClasses are not required.
+-}
+
+{- Note [Body in DisambECP]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There are helper functions (mkBodyStmt, mkBindStmt, unguardedRHS, etc) that
+require their argument to take a form of (body GhcPs) for some (body :: * ->
+*). To satisfy this requirement, we say that (b ~ Body b GhcPs) in the
+superclass constraints of DisambECP.
+
+The alternative is to change mkBodyStmt, mkBindStmt, unguardedRHS, etc, to drop
+this requirement. It is possible and would allow removing the type index of
+PatBuilder, but leads to worse type inference, breaking some code in the
+typechecker.
+-}
+
+instance p ~ GhcPs => DisambECP (HsCmd p) where
+  type Body (HsCmd p) = HsCmd
+  ecpFromCmd' = return
+  ecpFromExp' (dL-> L l e) = cmdFail l (ppr e)
+  mkHsLamPV l mg = return $ cL l (HsCmdLam noExt mg)
+  mkHsLetPV l bs e = return $ cL l (HsCmdLet noExt bs e)
+  type InfixOp (HsCmd p) = HsExpr p
+  superInfixOp m = m
+  mkHsOpAppPV l c1 op c2 = do
+    let cmdArg c = cL (getLoc c) $ HsCmdTop noExt c
+    return $ cL l $ HsCmdArrForm noExt op Infix Nothing [cmdArg c1, cmdArg c2]
+  mkHsCasePV l c mg = return $ cL l (HsCmdCase noExt c mg)
+  type FunArg (HsCmd p) = HsExpr p
+  superFunArg m = m
+  mkHsAppPV l c e = do
+    checkCmdBlockArguments c
+    checkExpBlockArguments e
+    return $ cL l (HsCmdApp noExt c e)
+  mkHsIfPV l c semi1 a semi2 b = do
+    checkDoAndIfThenElse c semi1 a semi2 b
+    return $ cL l (mkHsCmdIf c a b)
+  mkHsDoPV l stmts = return $ cL l (HsCmdDo noExt stmts)
+  mkHsParPV l c = return $ cL l (HsCmdPar noExt c)
+  mkHsVarPV (dL->L l v) = cmdFail l (ppr v)
+  mkHsLitPV (dL->L l a) = cmdFail l (ppr a)
+  mkHsOverLitPV (dL->L l a) = cmdFail l (ppr a)
+  mkHsWildCardPV l = cmdFail l (text "_")
+  mkHsTySigPV l a sig = cmdFail l (ppr a <+> text "::" <+> ppr sig)
+  mkHsExplicitListPV l xs = cmdFail l $
+    brackets (fsep (punctuate comma (map ppr xs)))
+  mkHsSplicePV (dL->L l sp) = cmdFail l (ppr sp)
+  mkHsRecordPV l _ a (fbinds, ddLoc) = cmdFail l $
+    ppr a <+> ppr (mk_rec_fields fbinds ddLoc)
+  mkHsNegAppPV l a = cmdFail l (text "-" <> ppr a)
+  mkHsSectionR_PV l op c = cmdFail l $
+    let pp_op = fromMaybe (panic "cannot print infix operator")
+                          (ppr_infix_expr (unLoc op))
+    in pp_op <> ppr c
+  mkHsViewPatPV l a b = cmdFail l $
+    ppr a <+> text "->" <+> ppr b
+  mkHsAsPatPV l v c = cmdFail l $
+    pprPrefixOcc (unLoc v) <> text "@" <> ppr c
+  mkHsLazyPatPV l c = cmdFail l $
+    text "~" <> ppr c
+  mkSumOrTuplePV l boxity a = cmdFail l (pprSumOrTuple boxity a)
+
+cmdFail :: SrcSpan -> SDoc -> PV a
+cmdFail loc e = addFatalError loc $
+  hang (text "Parse error in command:") 2 (ppr e)
+
+instance p ~ GhcPs => DisambECP (HsExpr p) where
+  type Body (HsExpr p) = HsExpr
+  ecpFromCmd' (dL -> L l c) = do
     addError l $ vcat
       [ text "Arrow command found where an expression was expected:",
         nest 2 (ppr c) ]
     return (cL l hsHoleExpr)
     addError l $ vcat
       [ text "Arrow command found where an expression was expected:",
         nest 2 (ppr c) ]
     return (cL l hsHoleExpr)
-  ecFromExp' = return
-  ecHsLam = HsLam noExt
-  ecHsLet = HsLet noExt
-  ecOpApp = OpApp noExt
-  ecHsCase = HsCase noExt
-  ecHsApp = HsApp noExt
-  ecHsIf = mkHsIf
-  ecHsDo = HsDo noExt DoExpr
-  ecHsPar = HsPar noExt
-  checkBlockArguments = checkExpBlockArguments
-  checkDoAndIfThenElse = checkDoAndIfThenElse'
+  ecpFromExp' = return
+  mkHsLamPV l mg = return $ cL l (HsLam noExt mg)
+  mkHsLetPV l bs c = return $ cL l (HsLet noExt bs c)
+  type InfixOp (HsExpr p) = HsExpr p
+  superInfixOp m = m
+  mkHsOpAppPV l e1 op e2 = do
+    return $ cL l $ OpApp noExt e1 op e2
+  mkHsCasePV l e mg = return $ cL l (HsCase noExt e mg)
+  type FunArg (HsExpr p) = HsExpr p
+  superFunArg m = m
+  mkHsAppPV l e1 e2 = do
+    checkExpBlockArguments e1
+    checkExpBlockArguments e2
+    return $ cL l (HsApp noExt e1 e2)
+  mkHsIfPV l c semi1 a semi2 b = do
+    checkDoAndIfThenElse c semi1 a semi2 b
+    return $ cL l (mkHsIf c a b)
+  mkHsDoPV l stmts = return $ cL l (HsDo noExt DoExpr stmts)
+  mkHsParPV l e = return $ cL l (HsPar noExt e)
+  mkHsVarPV v@(getLoc -> l) = return $ cL l (HsVar noExt v)
+  mkHsLitPV (dL->L l a) = return $ cL l (HsLit noExt a)
+  mkHsOverLitPV (dL->L l a) = return $ cL l (HsOverLit noExt a)
+  mkHsWildCardPV l = return $ cL l hsHoleExpr
+  mkHsTySigPV l a sig = return $ cL l (ExprWithTySig noExt a (mkLHsSigWcType sig))
+  mkHsExplicitListPV l xs = return $ cL l (ExplicitList noExt Nothing xs)
+  mkHsSplicePV sp = return $ mapLoc (HsSpliceE noExt) sp
+  mkHsRecordPV l lrec a (fbinds, ddLoc) = do
+    r <- mkRecConstrOrUpdate a lrec (fbinds, ddLoc)
+    checkRecordSyntax (cL l r)
+  mkHsNegAppPV l a = return $ cL l (NegApp noExt a noSyntaxExpr)
+  mkHsSectionR_PV l op e = return $ cL l (SectionR noExt op e)
+  mkHsViewPatPV l a b = patSynErr l (ppr a <+> text "->" <+> ppr b) empty
+  mkHsAsPatPV l v e = do
+    opt_TypeApplications <- getBit TypeApplicationsBit
+    let msg | opt_TypeApplications
+            = "Type application syntax requires a space before '@'"
+            | otherwise
+            = "Did you mean to enable TypeApplications?"
+    patSynErr l (pprPrefixOcc (unLoc v) <> text "@" <> ppr e) (text msg)
+  mkHsLazyPatPV l e = patSynErr l (text "~" <> ppr e) empty
+  mkSumOrTuplePV = mkSumOrTupleExpr
+
+patSynErr :: SrcSpan -> SDoc -> SDoc -> PV (LHsExpr GhcPs)
+patSynErr l e explanation =
+  do { addError l $
+        sep [text "Pattern syntax in expression context:",
+             nest 4 (ppr e)] $$
+        explanation
+     ; return (cL l hsHoleExpr) }
 
 hsHoleExpr :: HsExpr (GhcPass id)
 hsHoleExpr = HsUnboundVar noExt (TrueExprHole (mkVarOcc "_"))
 
 
 hsHoleExpr :: HsExpr (GhcPass id)
 hsHoleExpr = HsUnboundVar noExt (TrueExprHole (mkVarOcc "_"))
 
+-- | See Note [Ambiguous syntactic categories] and Note [PatBuilder]
+data PatBuilder p
+  = PatBuilderPat (Pat p)
+  | PatBuilderBang SrcSpan (Located (PatBuilder p))
+  | PatBuilderPar (Located (PatBuilder p))
+  | PatBuilderApp (Located (PatBuilder p)) (Located (PatBuilder p))
+  | PatBuilderOpApp (Located (PatBuilder p)) (Located RdrName) (Located (PatBuilder p))
+  | PatBuilderVar (Located RdrName)
+  | PatBuilderOverLit (HsOverLit GhcPs)
+
+patBuilderBang :: SrcSpan -> Located (PatBuilder p) -> Located (PatBuilder p)
+patBuilderBang bang p =
+  cL (bang `combineSrcSpans` getLoc p) $
+  PatBuilderBang bang p
+
+instance p ~ GhcPs => Outputable (PatBuilder p) where
+  ppr (PatBuilderPat p) = ppr p
+  ppr (PatBuilderBang _ (L _ p)) = text "!" <+> ppr p
+  ppr (PatBuilderPar (L _ p)) = parens (ppr p)
+  ppr (PatBuilderApp (L _ p1) (L _ p2)) = ppr p1 <+> ppr p2
+  ppr (PatBuilderOpApp (L _ p1) op (L _ p2)) = ppr p1 <+> ppr op <+> ppr p2
+  ppr (PatBuilderVar v) = ppr v
+  ppr (PatBuilderOverLit l) = ppr l
+
+instance p ~ GhcPs => DisambECP (PatBuilder p) where
+  type Body (PatBuilder p) = PatBuilder
+  ecpFromCmd' (dL-> L l c) =
+    addFatalError l $
+      text "Command syntax in pattern:" <+> ppr c
+  ecpFromExp' (dL-> L l e) =
+    addFatalError l $
+      text "Expression syntax in pattern:" <+> ppr e
+  mkHsLamPV l _ = addFatalError l $
+    text "Lambda-syntax in pattern." $$
+    text "Pattern matching on functions is not possible."
+  mkHsLetPV l _ _ = addFatalError l $ text "(let ... in ...)-syntax in pattern"
+  type InfixOp (PatBuilder p) = RdrName
+  superInfixOp m = m
+  mkHsOpAppPV l p1 op p2 = return $ cL l $ PatBuilderOpApp p1 op p2
+  mkHsCasePV l _ _ = addFatalError l $ text "(case ... of ...)-syntax in pattern"
+  type FunArg (PatBuilder p) = PatBuilder p
+  superFunArg m = m
+  mkHsAppPV l p1 p2 = return $ cL l (PatBuilderApp p1 p2)
+  mkHsIfPV l _ _ _ _ _ = addFatalError l $ text "(if ... then ... else ...)-syntax in pattern"
+  mkHsDoPV l _ = addFatalError l $ text "do-notation in pattern"
+  mkHsParPV l p = return $ cL l (PatBuilderPar p)
+  mkHsVarPV v@(getLoc -> l) = return $ cL l (PatBuilderVar v)
+  mkHsLitPV lit@(dL->L l a) = do
+    checkUnboxedStringLitPat lit
+    return $ cL l (PatBuilderPat (LitPat noExt a))
+  mkHsOverLitPV (dL->L l a) = return $ cL l (PatBuilderOverLit a)
+  mkHsWildCardPV l = return $ cL l (PatBuilderPat (WildPat noExt))
+  mkHsTySigPV l b sig = do
+    p <- checkLPat b
+    return $ cL l (PatBuilderPat (SigPat noExt p (mkLHsSigWcType sig)))
+  mkHsExplicitListPV l xs = do
+    ps <- traverse checkLPat xs
+    return (cL l (PatBuilderPat (ListPat noExt ps)))
+  mkHsSplicePV (dL->L l sp) = return $ cL l (PatBuilderPat (SplicePat noExt sp))
+  mkHsRecordPV l _ a (fbinds, ddLoc) = do
+    r <- mkPatRec a (mk_rec_fields fbinds ddLoc)
+    checkRecordSyntax (cL l r)
+  mkHsNegAppPV l (dL->L lp p) = do
+    lit <- case p of
+      PatBuilderOverLit pos_lit -> return (cL lp pos_lit)
+      _ -> patFail l (text "-" <> ppr p)
+    return $ cL l (PatBuilderPat (mkNPat lit (Just noSyntaxExpr)))
+  mkHsSectionR_PV l op p
+    | isBangRdr (unLoc op) = return $ cL l $ PatBuilderBang (getLoc op) p
+    | otherwise = patFail l (pprInfixOcc (unLoc op) <> ppr p)
+  mkHsViewPatPV l a b = do
+    p <- checkLPat b
+    return $ cL l (PatBuilderPat (ViewPat noExt a p))
+  mkHsAsPatPV l v e = do
+    p <- checkLPat e
+    return $ cL l (PatBuilderPat (AsPat noExt v p))
+  mkHsLazyPatPV l e = do
+    p <- checkLPat e
+    return $ cL l (PatBuilderPat (LazyPat noExt p))
+  mkSumOrTuplePV = mkSumOrTuplePat
+
+checkUnboxedStringLitPat :: Located (HsLit GhcPs) -> PV ()
+checkUnboxedStringLitPat (dL->L loc lit) =
+  case lit of
+    HsStringPrim _ _  -- Trac #13260
+      -> addFatalError loc (text "Illegal unboxed string literal in pattern:" $$ ppr lit)
+    _ -> return ()
+
+mkPatRec ::
+  Located (PatBuilder GhcPs) ->
+  HsRecFields GhcPs (Located (PatBuilder GhcPs)) ->
+  PV (PatBuilder GhcPs)
+mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd)
+  | isRdrDataCon (unLoc c)
+  = do fs <- mapM checkPatField fs
+       return (PatBuilderPat (ConPatIn c (RecCon (HsRecFields fs dd))))
+mkPatRec p _ =
+  addFatalError (getLoc p) $ text "Not a record constructor:" <+> ppr p
+
 {- Note [Ambiguous syntactic categories]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 {- Note [Ambiguous syntactic categories]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
@@ -2008,9 +2247,19 @@ concerns local to the parser, and does not require duplication of hsSyn types,
 or an extra pass over the entire AST, is to parse into an overloaded
 parser-validator (a so-called tagless final encoding):
 
 or an extra pass over the entire AST, is to parse into an overloaded
 parser-validator (a so-called tagless final encoding):
 
-    class ExpCmdI b where ...
-    instance ExpCmdI HsCmd where ...
-    instance ExpCmdI HsExp where ...
+    class DisambECP b where ...
+    instance p ~ GhcPs => DisambECP (HsCmd p) where ...
+    instance p ~ GhcPs => DisambECP (HsExp p) where ...
+    instance p ~ GhcPs => DisambECP (PatBuilder p) where ...
+
+The 'DisambECP' class contains functions to build and validate 'b'. For example,
+to add parentheses we have:
+
+  mkHsParPV :: DisambECP b => SrcSpan -> Located b -> PV (Located b)
+
+'mkHsParPV' will wrap the inner value in HsCmdPar for commands, HsPar for
+expressions, and 'PatBuilderPar' for patterns (later transformed into ParPat,
+see Note [PatBuilder]).
 
 Consider the 'alts' production used to parse case-of alternatives:
 
 
 Consider the 'alts' production used to parse case-of alternatives:
 
@@ -2018,9 +2267,9 @@ Consider the 'alts' production used to parse case-of alternatives:
     : alts1     { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
     | ';' alts  { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }
 
     : alts1     { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
     | ';' alts  { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }
 
-We abstract over LHsExpr, and it becomes:
+We abstract over LHsExpr GhcPs, and it becomes:
 
 
-  alts :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LMatch GhcPs (Located (b GhcPs))])) }
+  alts :: { forall b. DisambECP b => PV (Located ([AddAnn],[LMatch GhcPs (Located b)])) }
     : alts1     { $1 >>= \ $1 ->
                   return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
     | ';' alts  { $2 >>= \ $2 ->
     : alts1     { $1 >>= \ $1 ->
                   return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
     | ';' alts  { $2 >>= \ $2 ->
@@ -2028,9 +2277,9 @@ We abstract over LHsExpr, and it becomes:
 
 Compared to the initial definition, the added bits are:
 
 
 Compared to the initial definition, the added bits are:
 
-    forall b. ExpCmdI b => PV ( ... ) -- in the type signature
-    $1 >>= \ $1 -> return $           -- in one reduction rule
-    $2 >>= \ $2 -> return $           -- in another reduction rule
+    forall b. DisambECP b => PV ( ... ) -- in the type signature
+    $1 >>= \ $1 -> return $             -- in one reduction rule
+    $2 >>= \ $2 -> return $             -- in another reduction rule
 
 The overhead is constant relative to the size of the rest of the reduction
 rule, so this approach scales well to large parser productions.
 
 The overhead is constant relative to the size of the rest of the reduction
 rule, so this approach scales well to large parser productions.
@@ -2316,11 +2565,80 @@ thread 'tag' explicitly:
     | ';' alts  { $2 >>= \ $2 ->
                   return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }
 
     | ';' alts  { $2 >>= \ $2 ->
                   return $ sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) }
 
-This encoding works well enough for two cases (Exp vs Cmd), but it does not scale well to
-more cases (Exp vs Cmd vs Pat), as we would need multiple GADTs for all possible ambiguities.
+This encoding works well enough, but introduces an extra GADT unlike the
+tagless final encoding, and there's no need for this complexity.
 
 -}
 
 
 -}
 
+{- Note [PatBuilder]
+~~~~~~~~~~~~~~~~~~~~
+Unlike HsExpr or HsCmd, the Pat type cannot accomodate all intermediate forms,
+so we introduce the notion of a PatBuilder.
+
+Consider a pattern like this:
+
+  Con a b c
+
+We parse arguments to "Con" one at a time in the  fexp aexp  parser production,
+building the result with mkHsAppPV, so the intermediate forms are:
+
+  1. Con
+  2. Con a
+  3. Con a b
+  4. Con a b c
+
+In 'HsExpr', we have 'HsApp', so the intermediate forms are represented like
+this (pseudocode):
+
+  1. "Con"
+  2. HsApp "Con" "a"
+  3. HsApp (HsApp "Con" "a") "b"
+  3. HsApp (HsApp (HsApp "Con" "a") "b") "c"
+
+Similarly, in 'HsCmd' we have 'HsCmdApp'. In 'Pat', however, what we have
+instead is 'ConPatIn', which is very awkward to modify and thus unsuitable for
+the intermediate forms.
+
+Worse yet, some intermediate forms are not valid patterns at all. For example:
+
+  Con !a !b c
+
+This is parsed as ((Con ! a) ! (b c)) with ! as an infix operator, and then
+rearranged in 'splitBang'. But of course, neither (b c) nor (Con ! a) are valid
+patterns, so we cannot represent them as Pat.
+
+We also need an intermediate representation to postpone disambiguation between
+FunBind and PatBind. Consider:
+
+  a `Con` b = ...
+  a `fun` b = ...
+
+How do we know that (a `Con` b) is a PatBind but (a `fun` b) is a FunBind? We
+learn this by inspecting an intermediate representation in 'isFunLhs' and
+seeing that 'Con' is a data constructor but 'f' is not. We need an intermediate
+representation capable of representing both a FunBind and a PatBind, so Pat is
+insufficient.
+
+PatBuilder is an extension of Pat that is capable of representing intermediate
+parsing results for patterns and function bindings:
+
+  data PatBuilder p
+    = PatBuilderPat (Pat p)
+    | PatBuilderApp (Located (PatBuilder p)) (Located (PatBuilder p))
+    | PatBuilderOpApp (Located (PatBuilder p)) (Located RdrName) (Located (PatBuilder p))
+    ...
+
+It can represent any pattern via 'PatBuilderPat', but it also has a variety of
+other constructors which were added by following a simple principle: we never
+pattern match on the pattern stored inside 'PatBuilderPat'.
+
+For example, in 'splitBang' we need to match on space-separated and
+bang-separated patterns, so these are represented with dedicated constructors
+'PatBuilderApp' and 'PatBuilderOpApp'.  In 'isFunLhs', we pattern match on
+variables, so we have a dedicated 'PatBuilderVar' constructor for this despite
+the existence of 'VarPat'.
+-}
+
 ---------------------------------------------------------------------------
 -- Miscellaneous utilities
 
 ---------------------------------------------------------------------------
 -- Miscellaneous utilities
 
@@ -2342,7 +2660,7 @@ mkRecConstrOrUpdate
         :: LHsExpr GhcPs
         -> SrcSpan
         -> ([LHsRecField GhcPs (LHsExpr GhcPs)], Maybe SrcSpan)
         :: LHsExpr GhcPs
         -> SrcSpan
         -> ([LHsRecField GhcPs (LHsExpr GhcPs)], Maybe SrcSpan)
-        -> P (HsExpr GhcPs)
+        -> PV (HsExpr GhcPs)
 
 mkRecConstrOrUpdate (dL->L l (HsVar _ (dL->L _ c))) _ (fs,dd)
   | isRdrDataCon c
 
 mkRecConstrOrUpdate (dL->L l (HsVar _ (dL->L _ c))) _ (fs,dd)
   | isRdrDataCon c
@@ -2680,6 +2998,8 @@ localPV_msg f (PV m) = PV (local f m)
 instance MonadP PV where
   addError srcspan msg =
     PV $ ReaderT $ \ctxMsg -> addError srcspan (msg $$ ctxMsg)
 instance MonadP PV where
   addError srcspan msg =
     PV $ ReaderT $ \ctxMsg -> addError srcspan (msg $$ ctxMsg)
+  addWarning option srcspan msg =
+    PV $ ReaderT $ \_ -> addWarning option srcspan msg
   addFatalError srcspan msg =
     PV $ ReaderT $ \ctxMsg -> addFatalError srcspan (msg $$ ctxMsg)
   getBit ext =
   addFatalError srcspan msg =
     PV $ ReaderT $ \ctxMsg -> addFatalError srcspan (msg $$ ctxMsg)
   getBit ext =
@@ -2762,35 +3082,67 @@ the error messages.
 -}
 
 -- | Hint about bang patterns, assuming @BangPatterns@ is off.
 -}
 
 -- | Hint about bang patterns, assuming @BangPatterns@ is off.
-hintBangPat :: SrcSpan -> HsExpr GhcPs -> PV ()
+hintBangPat :: SrcSpan -> PatBuilder GhcPs -> PV ()
 hintBangPat span e = do
     bang_on <- getBit BangPatBit
     unless bang_on $
       addFatalError span
         (text "Illegal bang-pattern (use BangPatterns):" $$ ppr e)
 
 hintBangPat span e = do
     bang_on <- getBit BangPatBit
     unless bang_on $
       addFatalError span
         (text "Illegal bang-pattern (use BangPatterns):" $$ ppr e)
 
-data SumOrTuple
-  = Sum ConTag Arity (LHsExpr GhcPs)
-  | Tuple [LHsTupArg GhcPs]
+data SumOrTuple b
+  = Sum ConTag Arity (Located b)
+  | Tuple [Located (Maybe (Located b))]
+
+pprSumOrTuple :: Outputable b => Boxity -> SumOrTuple b -> SDoc
+pprSumOrTuple boxity = \case
+    Sum alt arity e ->
+      parOpen <+> ppr_bars (alt - 1) <+> ppr e <+> ppr_bars (arity - alt)
+              <+> parClose
+    Tuple xs ->
+      parOpen <> (fcat . punctuate comma $ map (maybe empty ppr . unLoc) xs)
+              <> parClose
+  where
+    ppr_bars n = hsep (replicate n (Outputable.char '|'))
+    (parOpen, parClose) =
+      case boxity of
+        Boxed -> (text "(", text ")")
+        Unboxed -> (text "(#", text "#)")
 
 
-mkSumOrTuple :: Boxity -> SrcSpan -> SumOrTuple -> P (HsExpr GhcPs)
+mkSumOrTupleExpr :: SrcSpan -> Boxity -> SumOrTuple (HsExpr GhcPs) -> PV (LHsExpr GhcPs)
 
 -- Tuple
 
 -- Tuple
-mkSumOrTuple boxity _ (Tuple es) = return (ExplicitTuple noExt es boxity)
+mkSumOrTupleExpr l boxity (Tuple es) =
+    return $ cL l (ExplicitTuple noExt (map toTupArg es) boxity)
+  where
+    toTupArg :: Located (Maybe (LHsExpr GhcPs)) -> LHsTupArg GhcPs
+    toTupArg = mapLoc (maybe missingTupArg (Present noExt))
 
 -- Sum
 
 -- Sum
-mkSumOrTuple Unboxed _ (Sum alt arity e) =
-    return (ExplicitSum noExt alt arity e)
-mkSumOrTuple Boxed l (Sum alt arity (dL->L _ e)) =
+mkSumOrTupleExpr l Unboxed (Sum alt arity e) =
+    return $ cL l (ExplicitSum noExt alt arity e)
+mkSumOrTupleExpr l Boxed a@Sum{} =
     addFatalError l (hang (text "Boxed sums not supported:") 2
     addFatalError l (hang (text "Boxed sums not supported:") 2
-                      (ppr_boxed_sum alt arity e))
+                      (pprSumOrTuple Boxed a))
+
+mkSumOrTuplePat :: SrcSpan -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
+
+-- Tuple
+mkSumOrTuplePat l boxity (Tuple ps) = do
+  ps' <- traverse toTupPat ps
+  return $ cL l (PatBuilderPat (TuplePat noExt ps' boxity))
   where
   where
-    ppr_boxed_sum :: ConTag -> Arity -> HsExpr GhcPs -> SDoc
-    ppr_boxed_sum alt arity e =
-      text "(" <+> ppr_bars (alt - 1) <+> ppr e <+> ppr_bars (arity - alt)
-      <+> text ")"
+    toTupPat :: Located (Maybe (Located (PatBuilder GhcPs))) -> PV (LPat GhcPs)
+    toTupPat (dL -> L l p) = case p of
+      Nothing -> addFatalError l (text "Tuple section in pattern context")
+      Just p' -> checkLPat p'
 
 
-    ppr_bars n = hsep (replicate n (Outputable.char '|'))
+-- Sum
+mkSumOrTuplePat l Unboxed (Sum alt arity p) = do
+   p' <- checkLPat p
+   return $ cL l (PatBuilderPat (SumPat noExt p' alt arity))
+mkSumOrTuplePat l Boxed a@Sum{} =
+    addFatalError l (hang (text "Boxed sums not supported:") 2
+                      (pprSumOrTuple Boxed a))
 
 mkLHsOpTy :: LHsType GhcPs -> Located RdrName -> LHsType GhcPs -> LHsType GhcPs
 mkLHsOpTy x op y =
 
 mkLHsOpTy :: LHsType GhcPs -> Located RdrName -> LHsType GhcPs -> LHsType GhcPs
 mkLHsOpTy x op y =
index dd38feb..7b00a62 100644 (file)
@@ -140,6 +140,9 @@ rnExpr (HsVar _ (L l v))
 rnExpr (HsIPVar x v)
   = return (HsIPVar x v, emptyFVs)
 
 rnExpr (HsIPVar x v)
   = return (HsIPVar x v, emptyFVs)
 
+rnExpr (HsUnboundVar x v)
+  = return (HsUnboundVar x v, emptyFVs)
+
 rnExpr (HsOverLabel x _ v)
   = do { rebindable_on <- xoptM LangExt.RebindableSyntax
        ; if rebindable_on
 rnExpr (HsOverLabel x _ v)
   = do { rebindable_on <- xoptM LangExt.RebindableSyntax
        ; if rebindable_on
@@ -346,24 +349,6 @@ rnExpr (ArithSeq x _ seq)
             return (ArithSeq x Nothing new_seq, fvs) }
 
 {-
             return (ArithSeq x Nothing new_seq, fvs) }
 
 {-
-These three are pattern syntax appearing in expressions.
-Since all the symbols are reservedops we can simply reject them.
-We return a (bogus) EWildPat in each case.
--}
-
-rnExpr (EWildPat _)  = return (hsHoleExpr, emptyFVs)   -- "_" is just a hole
-rnExpr e@(EAsPat {})
-  = do { opt_TypeApplications <- xoptM LangExt.TypeApplications
-       ; let msg | opt_TypeApplications
-                    = "Type application syntax requires a space before '@'"
-                 | otherwise
-                    = "Did you mean to enable TypeApplications?"
-       ; patSynErr e (text msg)
-       }
-rnExpr e@(EViewPat {}) = patSynErr e empty
-rnExpr e@(ELazyPat {}) = patSynErr e empty
-
-{-
 ************************************************************************
 *                                                                      *
         Static values
 ************************************************************************
 *                                                                      *
         Static values
@@ -415,9 +400,6 @@ rnExpr (HsProc x pat body)
 rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
         -- HsWrap
 
 rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
         -- HsWrap
 
-hsHoleExpr :: HsExpr (GhcPass id)
-hsHoleExpr = HsUnboundVar noExt (TrueExprHole (mkVarOcc "_"))
-
 ----------------------
 -- See Note [Parsing sections] in Parser.y
 rnSection :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
 ----------------------
 -- See Note [Parsing sections] in Parser.y
 rnSection :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
@@ -2087,12 +2069,6 @@ sectionErr expr
   = hang (text "A section must be enclosed in parentheses")
        2 (text "thus:" <+> (parens (ppr expr)))
 
   = hang (text "A section must be enclosed in parentheses")
        2 (text "thus:" <+> (parens (ppr expr)))
 
-patSynErr :: HsExpr GhcPs -> SDoc -> RnM (HsExpr GhcRn, FreeVars)
-patSynErr e explanation = do { addErr (sep [text "Pattern syntax in expression context:",
-                                nest 4 (ppr e)] $$
-                                  explanation)
-                 ; return (EWildPat noExt, emptyFVs) }
-
 badIpBinds :: Outputable a => SDoc -> a -> SDoc
 badIpBinds what binds
   = hang (text "Implicit-parameter bindings illegal in" <+> what)
 badIpBinds :: Outputable a => SDoc -> a -> SDoc
 badIpBinds what binds
   = hang (text "Implicit-parameter bindings illegal in" <+> what)
index 2a2f05e..bc30756 100644 (file)
@@ -3662,10 +3662,6 @@ exprCtOrigin (HsStatic {})       = Shouldn'tHappenOrigin "static expression"
 exprCtOrigin (HsTick _ _ e)           = lexprCtOrigin e
 exprCtOrigin (HsBinTick _ _ _ e)      = lexprCtOrigin e
 exprCtOrigin (HsTickPragma _ _ _ _ e) = lexprCtOrigin e
 exprCtOrigin (HsTick _ _ e)           = lexprCtOrigin e
 exprCtOrigin (HsBinTick _ _ _ e)      = lexprCtOrigin e
 exprCtOrigin (HsTickPragma _ _ _ _ e) = lexprCtOrigin e
-exprCtOrigin (EWildPat {})      = panic "exprCtOrigin EWildPat"
-exprCtOrigin (EAsPat {})        = panic "exprCtOrigin EAsPat"
-exprCtOrigin (EViewPat {})      = panic "exprCtOrigin EViewPat"
-exprCtOrigin (ELazyPat {})      = panic "exprCtOrigin ELazyPat"
 exprCtOrigin (HsWrap {})        = panic "exprCtOrigin HsWrap"
 exprCtOrigin (XExpr {})         = panic "exprCtOrigin XExpr"
 
 exprCtOrigin (HsWrap {})        = panic "exprCtOrigin HsWrap"
 exprCtOrigin (XExpr {})         = panic "exprCtOrigin XExpr"
 
index 69839e3..f50166f 100644 (file)
@@ -1,4 +1,4 @@
 
 
-InfixAppPatErr.hs:2:3: error:
-    Parse error in pattern: f $ do a <- return 3 c
+InfixAppPatErr.hs:2:7: error:
+    do-notation in pattern
     Possibly caused by a missing 'do'?
     Possibly caused by a missing 'do'?
index 4c723a7..6d25a36 100644 (file)
@@ -1,4 +1,4 @@
 
 
-T984.hs:6:9:
-    Parse error in pattern: case () of { _ -> result }
+T984.hs:6:9: error:
+    (case ... of ...)-syntax in pattern
     Possibly caused by a missing 'do'?
     Possibly caused by a missing 'do'?
index aa089de..2fc7f3d 100644 (file)
@@ -143,3 +143,21 @@ test('unpack_inside_type', normal, compile_fail, [''])
 test('unpack_before_opr', normal, compile_fail, [''])
 test('T16270', normal, compile_fail, [''])
 test('T16270h', normal, compile_fail, [''])
 test('unpack_before_opr', normal, compile_fail, [''])
 test('T16270', normal, compile_fail, [''])
 test('T16270h', normal, compile_fail, [''])
+test('cmdFail001', normal, compile_fail, [''])
+test('cmdFail002', normal, compile_fail, [''])
+test('cmdFail003', normal, compile_fail, [''])
+test('cmdFail004', normal, compile_fail, [''])
+test('cmdFail005', normal, compile_fail, [''])
+test('cmdFail006', normal, compile_fail, [''])
+test('cmdFail007', normal, compile_fail, [''])
+test('cmdFail008', normal, compile_fail, [''])
+test('cmdFail009', normal, compile_fail, [''])
+test('patFail001', normal, compile_fail, [''])
+test('patFail002', normal, compile_fail, [''])
+test('patFail003', normal, compile_fail, [''])
+test('patFail004', normal, compile_fail, [''])
+test('patFail005', normal, compile_fail, [''])
+test('patFail006', normal, compile_fail, [''])
+test('patFail007', normal, compile_fail, [''])
+test('patFail008', normal, compile_fail, [''])
+test('patFail009', normal, compile_fail, [''])
diff --git a/testsuite/tests/parser/should_fail/cmdFail001.hs b/testsuite/tests/parser/should_fail/cmdFail001.hs
new file mode 100644 (file)
index 0000000..c5a4f2f
--- /dev/null
@@ -0,0 +1,4 @@
+{-# LANGUAGE Arrows #-}
+module CmdFail001 where
+
+f = proc x -> _
diff --git a/testsuite/tests/parser/should_fail/cmdFail001.stderr b/testsuite/tests/parser/should_fail/cmdFail001.stderr
new file mode 100644 (file)
index 0000000..7f8210a
--- /dev/null
@@ -0,0 +1,2 @@
+
+cmdFail001.hs:4:15: error: Parse error in command: _
diff --git a/testsuite/tests/parser/should_fail/cmdFail002.hs b/testsuite/tests/parser/should_fail/cmdFail002.hs
new file mode 100644 (file)
index 0000000..a75a4d2
--- /dev/null
@@ -0,0 +1,4 @@
+{-# LANGUAGE Arrows #-}
+module CmdFail002 where
+
+f = proc x -> (_ -< _) :: _
diff --git a/testsuite/tests/parser/should_fail/cmdFail002.stderr b/testsuite/tests/parser/should_fail/cmdFail002.stderr
new file mode 100644 (file)
index 0000000..1e03933
--- /dev/null
@@ -0,0 +1,2 @@
+
+cmdFail002.hs:4:15: error: Parse error in command: (_ -< _) :: _
diff --git a/testsuite/tests/parser/should_fail/cmdFail003.hs b/testsuite/tests/parser/should_fail/cmdFail003.hs
new file mode 100644 (file)
index 0000000..03b8b82
--- /dev/null
@@ -0,0 +1,8 @@
+{-# LANGUAGE Arrows #-}
+module CmdFail003 where
+
+f = proc x -> [_ -< _,
+               _ -< _,
+               _ -< _,
+               _ -< _,
+               _ -< _]
diff --git a/testsuite/tests/parser/should_fail/cmdFail003.stderr b/testsuite/tests/parser/should_fail/cmdFail003.stderr
new file mode 100644 (file)
index 0000000..21f9581
--- /dev/null
@@ -0,0 +1,3 @@
+
+cmdFail003.hs:4:15: error:
+    Parse error in command: [_ -< _, _ -< _, _ -< _, _ -< _, _ -< _]
diff --git a/testsuite/tests/parser/should_fail/cmdFail004.hs b/testsuite/tests/parser/should_fail/cmdFail004.hs
new file mode 100644 (file)
index 0000000..89898cb
--- /dev/null
@@ -0,0 +1,4 @@
+{-# LANGUAGE Arrows #-}
+module CmdFail004 where
+
+f = proc x -> (_ -> (_ -< _))
diff --git a/testsuite/tests/parser/should_fail/cmdFail004.stderr b/testsuite/tests/parser/should_fail/cmdFail004.stderr
new file mode 100644 (file)
index 0000000..ed14937
--- /dev/null
@@ -0,0 +1,2 @@
+
+cmdFail004.hs:4:16: error: Parse error in command: _ -> (_ -< _)
diff --git a/testsuite/tests/parser/should_fail/cmdFail005.hs b/testsuite/tests/parser/should_fail/cmdFail005.hs
new file mode 100644 (file)
index 0000000..a665ddd
--- /dev/null
@@ -0,0 +1,4 @@
+{-# LANGUAGE Arrows #-}
+module CmdFail005 where
+
+f = proc x -> x@(_ -< _)
diff --git a/testsuite/tests/parser/should_fail/cmdFail005.stderr b/testsuite/tests/parser/should_fail/cmdFail005.stderr
new file mode 100644 (file)
index 0000000..9944ff2
--- /dev/null
@@ -0,0 +1,2 @@
+
+cmdFail005.hs:4:15: error: Parse error in command: x@(_ -< _)
diff --git a/testsuite/tests/parser/should_fail/cmdFail006.hs b/testsuite/tests/parser/should_fail/cmdFail006.hs
new file mode 100644 (file)
index 0000000..5953d74
--- /dev/null
@@ -0,0 +1,4 @@
+{-# LANGUAGE Arrows #-}
+module CmdFail006 where
+
+f = proc x -> ~(_ -< _)
diff --git a/testsuite/tests/parser/should_fail/cmdFail006.stderr b/testsuite/tests/parser/should_fail/cmdFail006.stderr
new file mode 100644 (file)
index 0000000..ad64e91
--- /dev/null
@@ -0,0 +1,2 @@
+
+cmdFail006.hs:4:15: error: Parse error in command: ~(_ -< _)
diff --git a/testsuite/tests/parser/should_fail/cmdFail007.hs b/testsuite/tests/parser/should_fail/cmdFail007.hs
new file mode 100644 (file)
index 0000000..1d3c3ad
--- /dev/null
@@ -0,0 +1,7 @@
+{-# LANGUAGE Arrows #-}
+module CmdFail007 where
+
+f = proc x ->
+      (_ -< _) { a = _ -< _,
+                 b = _ -< _,
+                 c = _ -< _ }
diff --git a/testsuite/tests/parser/should_fail/cmdFail007.stderr b/testsuite/tests/parser/should_fail/cmdFail007.stderr
new file mode 100644 (file)
index 0000000..82dadb6
--- /dev/null
@@ -0,0 +1,4 @@
+
+cmdFail007.hs:5:7: error:
+    Parse error in command:
+      (_ -< _) {a = _ -< _, b = _ -< _, c = _ -< _}
diff --git a/testsuite/tests/parser/should_fail/cmdFail008.hs b/testsuite/tests/parser/should_fail/cmdFail008.hs
new file mode 100644 (file)
index 0000000..76e9864
--- /dev/null
@@ -0,0 +1,4 @@
+{-# LANGUAGE Arrows #-}
+module CmdFail008 where
+
+f = proc x -> (! (_ -< _))
diff --git a/testsuite/tests/parser/should_fail/cmdFail008.stderr b/testsuite/tests/parser/should_fail/cmdFail008.stderr
new file mode 100644 (file)
index 0000000..0f2f081
--- /dev/null
@@ -0,0 +1,2 @@
+
+cmdFail008.hs:4:16: error: Parse error in command: !(_ -< _)
diff --git a/testsuite/tests/parser/should_fail/cmdFail009.hs b/testsuite/tests/parser/should_fail/cmdFail009.hs
new file mode 100644 (file)
index 0000000..e61ba08
--- /dev/null
@@ -0,0 +1,8 @@
+{-# LANGUAGE Arrows #-}
+module CmdFail009 where
+
+f = proc x -> (_ -< _,
+               _ -< _,
+               _ -< _,
+               _ -< _,
+               _ -< _)
diff --git a/testsuite/tests/parser/should_fail/cmdFail009.stderr b/testsuite/tests/parser/should_fail/cmdFail009.stderr
new file mode 100644 (file)
index 0000000..a0c4af5
--- /dev/null
@@ -0,0 +1,3 @@
+
+cmdFail009.hs:4:15: error:
+    Parse error in command: (_ -< _,_ -< _,_ -< _,_ -< _,_ -< _)
diff --git a/testsuite/tests/parser/should_fail/patFail001.hs b/testsuite/tests/parser/should_fail/patFail001.hs
new file mode 100644 (file)
index 0000000..1e41ed2
--- /dev/null
@@ -0,0 +1,3 @@
+module PatFail001 where
+
+f (\x -> a) = _
diff --git a/testsuite/tests/parser/should_fail/patFail001.stderr b/testsuite/tests/parser/should_fail/patFail001.stderr
new file mode 100644 (file)
index 0000000..6dd20d7
--- /dev/null
@@ -0,0 +1,4 @@
+
+patFail001.hs:3:4: error:
+    Lambda-syntax in pattern.
+    Pattern matching on functions is not possible.
diff --git a/testsuite/tests/parser/should_fail/patFail002.hs b/testsuite/tests/parser/should_fail/patFail002.hs
new file mode 100644 (file)
index 0000000..b6be3c4
--- /dev/null
@@ -0,0 +1,3 @@
+module PatFail002 where
+
+f (let a = x in a) = _
diff --git a/testsuite/tests/parser/should_fail/patFail002.stderr b/testsuite/tests/parser/should_fail/patFail002.stderr
new file mode 100644 (file)
index 0000000..804bfe9
--- /dev/null
@@ -0,0 +1,2 @@
+
+patFail002.hs:3:4: error: (let ... in ...)-syntax in pattern
diff --git a/testsuite/tests/parser/should_fail/patFail003.hs b/testsuite/tests/parser/should_fail/patFail003.hs
new file mode 100644 (file)
index 0000000..aab9750
--- /dev/null
@@ -0,0 +1,3 @@
+module PatFail003 where
+
+f (case x of a -> b) = _
diff --git a/testsuite/tests/parser/should_fail/patFail003.stderr b/testsuite/tests/parser/should_fail/patFail003.stderr
new file mode 100644 (file)
index 0000000..dc6e7aa
--- /dev/null
@@ -0,0 +1,2 @@
+
+patFail003.hs:3:4: error: (case ... of ...)-syntax in pattern
diff --git a/testsuite/tests/parser/should_fail/patFail004.hs b/testsuite/tests/parser/should_fail/patFail004.hs
new file mode 100644 (file)
index 0000000..0bc1ada
--- /dev/null
@@ -0,0 +1,3 @@
+module PatFail004 where
+
+f (if c then a else b) = _
diff --git a/testsuite/tests/parser/should_fail/patFail004.stderr b/testsuite/tests/parser/should_fail/patFail004.stderr
new file mode 100644 (file)
index 0000000..48d289c
--- /dev/null
@@ -0,0 +1,3 @@
+
+patFail004.hs:3:4: error:
+    (if ... then ... else ...)-syntax in pattern
diff --git a/testsuite/tests/parser/should_fail/patFail005.hs b/testsuite/tests/parser/should_fail/patFail005.hs
new file mode 100644 (file)
index 0000000..b140752
--- /dev/null
@@ -0,0 +1,3 @@
+module PatFail005 where
+
+f (do a; b; c) = _
diff --git a/testsuite/tests/parser/should_fail/patFail005.stderr b/testsuite/tests/parser/should_fail/patFail005.stderr
new file mode 100644 (file)
index 0000000..1302d62
--- /dev/null
@@ -0,0 +1,2 @@
+
+patFail005.hs:3:4: error: do-notation in pattern
diff --git a/testsuite/tests/parser/should_fail/patFail006.hs b/testsuite/tests/parser/should_fail/patFail006.hs
new file mode 100644 (file)
index 0000000..ede9ad3
--- /dev/null
@@ -0,0 +1,3 @@
+module PatFail006 where
+
+f (-(1)) = _
diff --git a/testsuite/tests/parser/should_fail/patFail006.stderr b/testsuite/tests/parser/should_fail/patFail006.stderr
new file mode 100644 (file)
index 0000000..270f738
--- /dev/null
@@ -0,0 +1,2 @@
+
+patFail006.hs:3:4: error: Parse error in pattern: -(1)
diff --git a/testsuite/tests/parser/should_fail/patFail007.hs b/testsuite/tests/parser/should_fail/patFail007.hs
new file mode 100644 (file)
index 0000000..fb6a48d
--- /dev/null
@@ -0,0 +1,3 @@
+module PatFail007 where
+
+f (+1) = _
diff --git a/testsuite/tests/parser/should_fail/patFail007.stderr b/testsuite/tests/parser/should_fail/patFail007.stderr
new file mode 100644 (file)
index 0000000..f07689b
--- /dev/null
@@ -0,0 +1,2 @@
+
+patFail007.hs:3:4: error: Parse error in pattern: +1
diff --git a/testsuite/tests/parser/should_fail/patFail008.hs b/testsuite/tests/parser/should_fail/patFail008.hs
new file mode 100644 (file)
index 0000000..a4b5a3b
--- /dev/null
@@ -0,0 +1,4 @@
+{-# LANGUAGE Arrows #-}
+module PatFail008 where
+
+f (a -< b) = _
diff --git a/testsuite/tests/parser/should_fail/patFail008.stderr b/testsuite/tests/parser/should_fail/patFail008.stderr
new file mode 100644 (file)
index 0000000..d9957d9
--- /dev/null
@@ -0,0 +1,2 @@
+
+patFail008.hs:4:4: error: Command syntax in pattern: a -< b
diff --git a/testsuite/tests/parser/should_fail/patFail009.hs b/testsuite/tests/parser/should_fail/patFail009.hs
new file mode 100644 (file)
index 0000000..53e54a7
--- /dev/null
@@ -0,0 +1,4 @@
+{-# LANGUAGE OverloadedLabels #-}
+module PatFail009 where
+
+f #a = _
diff --git a/testsuite/tests/parser/should_fail/patFail009.stderr b/testsuite/tests/parser/should_fail/patFail009.stderr
new file mode 100644 (file)
index 0000000..0c9fb5d
--- /dev/null
@@ -0,0 +1,2 @@
+
+patFail009.hs:4:3: error: Expression syntax in pattern: #a