diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index 89ca815ed53d7b4294152afc962e4113d2f82fe6..12b0c838a69ddd5b06916c4f95e9f9f80451e0cf 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -752,10 +752,6 @@ ds_expr _ (HsTickPragma _ _ _ _ expr) = do
 
 -- 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"
diff --git a/compiler/hieFile/HieAst.hs b/compiler/hieFile/HieAst.hs
index 2ab2acbe3fa6bb355d0a0ea1f59ab92a6df69d2b..d86077ea27dc5dda1167605bded0e5588c7f837d 100644
--- a/compiler/hieFile/HieAst.hs
+++ b/compiler/hieFile/HieAst.hs
@@ -870,18 +870,6 @@ instance ( a ~ GhcPass p
       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
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index b86f4a147d78805769dd830cdb89a6e992b63689..9052855c6936ce81da74a2bf7b24b8cc4e5c1805 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -624,32 +624,6 @@ data HsExpr p
         -- See note [Pragma source text] in BasicTypes
      (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.
@@ -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 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
 
@@ -924,21 +894,12 @@ ppr_expr e@(HsApp {})        = ppr_apps e []
 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
-    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
 
@@ -951,36 +912,30 @@ ppr_expr (OpApp _ e1 op e2)
 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_ )"])
 
-    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)
-  = 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)
 
-    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))
@@ -1057,11 +1012,6 @@ ppr_expr (ExprWithTySig _ expr sig)
 
 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
@@ -1110,6 +1060,14 @@ ppr_expr (HsTickPragma _ _ externalSrcLoc _ exp)
 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)))]
@@ -1196,10 +1154,6 @@ hsExprNeedsParens p = go
     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
diff --git a/compiler/hsSyn/HsExtension.hs b/compiler/hsSyn/HsExtension.hs
index 1bebec0896d2d9acdafdfc8c3b7f1ceeaba160aa..1d14da20b99ace3c95983690948a81b25befa4c6 100644
--- a/compiler/hsSyn/HsExtension.hs
+++ b/compiler/hsSyn/HsExtension.hs
@@ -539,10 +539,6 @@ type family XStatic         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
 
@@ -587,10 +583,6 @@ type ForallXExpr (c :: * -> Constraint) (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)
        )
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index c23c320ac9572c20d5e015ae975e327b3ac969e9..3c1ea8cc7db0ae7d28513f8c1f78fd20a4d80be7 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -58,7 +58,6 @@ module Lexer (
    activeContext, nextIsEOF,
    getLexState, popLexState, pushLexState,
    ExtBits(..),
-   addWarning,
    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 ()
+  -- | 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
@@ -2515,6 +2517,16 @@ instance MonadP P where
                      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)
@@ -2524,20 +2536,6 @@ instance MonadP P where
     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} ->
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 4bc3fa9ad041076713b5860d712b90c70709ed8d..80e197e0393401895b17b739de8912069050aec2 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -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
-        | infixexp_top                          { sLL $1 $> $ mkSpliceDecl $1 }
+        | infixexp_top                          {% runECP_P $1 >>= \ $1 ->
+                                                   return $ sLL $1 $> $ mkSpliceDecl $1 }
 
 -- Type classes
 --
@@ -1509,7 +1510,7 @@ decl_cls  : at_decl_cls                 { $1 }
 
           -- 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)
@@ -1649,8 +1650,8 @@ rules   :: { OrdList (LRuleDecl GhcPs) }
 
 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
@@ -1760,19 +1761,19 @@ stringlist :: { Located (OrdList (Located StringLiteral)) }
 -----------------------------------------------------------------------------
 -- 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] }
 
-    | '{-# 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] }
 
-    | '{-# 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))
@@ -2393,8 +2394,8 @@ docdecld :: { LDocDecl }
 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) ;
@@ -2410,7 +2411,8 @@ decl_no_th :: { LHsDecl GhcPs }
                                         _ <- 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
@@ -2434,7 +2436,7 @@ decl    :: { LHsDecl 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)
@@ -2448,7 +2450,7 @@ gdrhs :: { Located [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] }
 
@@ -2456,7 +2458,8 @@ sigdecl :: { LHsDecl GhcPs }
         :
         -- 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))} }
@@ -2548,84 +2551,90 @@ quasiquote :: { Located (HsSplice GhcPs) }
                                 ; 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] }
-        | 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] }
-        | 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] }
-        | 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] }
-        | 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 }
 
-infixexp :: { ExpCmdP }
+infixexp :: { ECP }
         : 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
 
-infixexp_top :: { LHsExpr GhcPs }
-            : exp10_top               {% runExpCmdP $1 }
+infixexp_top :: { ECP }
+            : exp10_top               { $1 }
             | 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)
-                                                && checkIfBang $2) $
+                                                && checkIfBang (unLoc $2)) $
                                                 warnSpaceAfterBang (comb2 $2 $3);
-                                              ams (sLL $1 $> (OpApp noExt $1 $2 $3))
+                                              amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3)
                                                    [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] }
 
 
-        | 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) }
 
-        | '{-# 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 }
 
-exp10 :: { ExpCmdP }
+exp10 :: { ECP }
         : 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) }
 
@@ -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] }
-        | '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 }
 
-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
 
-        | '~' 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
-                   {  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] }
-        | '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 ->
-               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
-                         {% 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) >>= \_ ->
-                                           fmap ecFromExp $
+                                           fmap ecpFromExp $
                                            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 ->
-                                           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)) }
-        | 'do' stmtlist              { ExpCmdP $
+        | 'do' stmtlist              { ECP $
                                         $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 ->
-                                       fmap ecFromExp $
+                                       fmap ecpFromExp $
                                        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 }
 
-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   :: { 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) }
-        | 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.
-        | '(' 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
-        | 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) }
-        | '[|' 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]) }
-        | '[||' 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]) }
-        | '[t|' ktype '|]'    {% fmap ecFromExp $
+        | '[t|' ktype '|]'    {% fmap ecpFromExp $
                                  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] }
-        | '[d|' cvtopbody '|]' {% fmap ecFromExp $
+        | '[d|' cvtopbody '|]' {% fmap ecpFromExp $
                                   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
-        | '(|' 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] }
@@ -2850,7 +2856,7 @@ splice_untyped :: { Located (HsSplice GhcPs) }
                                         (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] }
 
@@ -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] }
-        | '$$(' exp ')'         {% runExpCmdP $2 >>= \ $2 ->
+        | '$$(' exp ')'         {% runECP_P $2 >>= \ $2 ->
                                     ams (sLL $1 $> $ mkTypedSplice HasParens $2)
                                        [mj AnnOpenPTE $1,mj AnnCloseP $3] }
 
@@ -2868,7 +2874,7 @@ cmdargs :: { [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]) }
@@ -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 :: { ExpCmdP }
+texp :: { ECP }
         : 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.
-        | infixexp qop       {% runExpCmdP $1 >>= \ $1 ->
-                                return $ ecFromExp $
+        | infixexp qop       {% runECP_P $1 >>= \ $1 ->
+                                runPV $2 >>= \ $2 ->
+                                return $ ecpFromExp $
                                 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
-        | 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.
-tup_exprs :: { ([AddAnn],SumOrTuple) }
+tup_exprs :: { forall b. DisambECP b => PV ([AddAnn],SumOrTuple b) }
            : texp commas_tup_tail
-                          {% runExpCmdP $1 >>= \ $1 ->
+                           { runECP_PV $1 >>= \ $1 ->
+                             $2 >>= \ $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
-                {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1)
+                 { $2 >>= \ $2 ->
+                   do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1)
                       ; return
-                           ([],Tuple (map (\l -> cL l missingTupArg) (fst $1) ++ $2)) } }
+                           ([],Tuple (map (\l -> cL l Nothing) (fst $1) ++ $2)) } }
 
            | 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
-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
-       {% 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
-            ,(map (\l -> cL l missingTupArg) (tail $ fst $1)) ++ $2)) } }
+            ,(map (\l -> cL l Nothing) (tail $ fst $1)) ++ $2)) } }
 
 -- 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 :: { ([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
-             {% 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) >>
-                                      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) >>
-                                      return (sLL $1 $> [$3,$1]) }
+                                      return [$3,$1] }
 
 -----------------------------------------------------------------------------
 -- 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*
-    : 'then' exp              {% runExpCmdP $2 >>= \ $2 -> return $
+    : 'then' exp              {% runECP_P $2 >>= \ $2 -> return $
                                  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
-            {% 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
-            {% 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)) }
 
@@ -3078,7 +3098,7 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
 -----------------------------------------------------------------------------
 -- 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))) }
@@ -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 ([],[]) }
 
-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   :: { 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)
@@ -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]) }
 
-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
@@ -3121,18 +3141,18 @@ alt     :: { forall b. ExpCmdI b => PV (LMatch GhcPs (Located (b GhcPs))) }
                                                   , 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 :: { 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)) }
 
-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) }
@@ -3147,9 +3167,9 @@ ifgdpats :: { Located ([AddAnn],[LGRHS GhcPs (LHsExpr GhcPs)]) }
          |     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
-                                   { runExpCmdPV $4 >>= \ $4 ->
+                                   { runECP_PV $4 >>= \ $4 ->
                                      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 }
-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 }
-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'?")
-                                     (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 }
-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] }
@@ -3189,7 +3205,7 @@ apats  :: { [LPat GhcPs] }
 -----------------------------------------------------------------------------
 -- 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?
@@ -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
 
-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)
@@ -3236,17 +3252,17 @@ maybe_stmt :: { Maybe (LStmt GhcPs (LHsExpr GhcPs)) }
 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  :: { 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] }
-    | 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)) }
@@ -3254,26 +3270,30 @@ qual  :: { forall b. ExpCmdI b => PV (LStmt GhcPs (Located (b GhcPs))) }
 -----------------------------------------------------------------------------
 -- 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 }
-        | {- 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
-                {% 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))) }
-        | 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 }) = ...
 
-        | 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
 
@@ -3291,7 +3311,7 @@ dbinds  :: { Located [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] }
 
@@ -3505,18 +3525,18 @@ varop   :: { Located RdrName }
                                        [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 }
 
-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 :: { 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] }
 
@@ -3943,12 +3963,8 @@ hintExplicitForall tok = do
   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
-warnSpaceAfterBang :: SrcSpan -> P ()
+warnSpaceAfterBang :: SrcSpan -> PV ()
 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
-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 }
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index f4b909b37a9f5db092bdd64f7bfedb6b19493997..8d15cb317b0c140afe98e45baa925fe4ae10c485 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -13,8 +13,6 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module   RdrHsSyn (
@@ -51,11 +49,11 @@ module   RdrHsSyn (
 
         -- 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,
-        bang_RDR,
         isBangRdr,
         isTildeRdr,
         checkMonadComp,       -- P (HsStmtContext RdrName)
@@ -85,16 +83,19 @@ module   RdrHsSyn (
         warnStarIsType,
         failOpFewArgs,
 
-        SumOrTuple (..), mkSumOrTuple,
+        SumOrTuple (..),
 
-        -- Expression/command ambiguity resolution
+        -- Expression/command/pattern ambiguity resolution
         PV,
         runPV,
-        ExpCmdP(ExpCmdP, runExpCmdPV),
-        runExpCmdP,
-        ExpCmdI(..),
-        ecFromExp,
-        ecFromCmd,
+        ECP(ECP, runECP_PV),
+        runECP_P,
+        DisambInfixOp(..),
+        DisambECP(..),
+        ecpFromExp,
+        ecpFromCmd,
+        PatBuilder,
+        patBuilderBang,
 
     ) where
 
@@ -911,7 +912,7 @@ checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName)
                                     ++ 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 $
@@ -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.
 
-checkPattern :: LHsExpr GhcPs -> P (LPat GhcPs)
+checkPattern :: Located (PatBuilder GhcPs) -> P (LPat GhcPs)
 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 []
 
-checkPat :: SrcSpan -> LHsExpr GhcPs -> [LPat GhcPs]
+checkPat :: SrcSpan -> Located (PatBuilder GhcPs) -> [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") $
-      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 (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 _
-  = 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
-   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
-   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') }
 
-   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
-   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))
-   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))
 
-   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
-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
-bang_RDR = mkUnqual varName (fsLit "!") -- Hack
 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)
 
-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 }))
 
-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")
 
-
 ---------------------------------------------------------------------------
 -- 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
-  = 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
@@ -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)
-            Nothing -> checkPatBind lhs g }
+            Nothing -> do
+              lhs' <- checkPattern lhs
+              checkPatBind lhs' g }
 
 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)
@@ -1242,13 +1207,11 @@ makeFunBind fn ms
               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))
-  = 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)))
@@ -1282,10 +1245,10 @@ checkValSigLhs lhs@(dL->L l _)
     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 ()
-checkDoAndIfThenElse' guardExpr semiThen thenExpr semiElse elseExpr
+checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
  | 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
-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])
-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
-    l' = combineLocs bang arg1
+    l' = combineLocs op arg1
     (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]
-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
 --
@@ -1331,17 +1295,15 @@ isFunLhs :: LHsExpr GhcPs
 
 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))
-   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]
-   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
@@ -1356,7 +1318,7 @@ isFunLhs e = go e [] []
       -- 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
@@ -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
-                     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
 
@@ -1856,7 +1818,7 @@ mergeDataCon all_xs =
 -- 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
@@ -1864,96 +1826,373 @@ checkMonadComp = do
                 else ListComp
 
 -- -------------------------------------------------------------------------
--- Expression/command ambiguity (arrow syntax).
+-- Expression/command/pattern ambiguity.
 -- 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]
-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]
-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.
-  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.
-  ecFromExp' :: LHsExpr GhcPs -> PV (Located (b GhcPs))
+  ecpFromExp' :: LHsExpr GhcPs -> PV (Located b)
   -- | Disambiguate "\... -> ..." (lambda)
-  ecHsLam :: MatchGroup GhcPs (Located (b GhcPs)) -> b GhcPs
+  mkHsLamPV :: SrcSpan -> MatchGroup GhcPs (Located b) -> PV (Located b)
   -- | 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)
-  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 ..."
-  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)
-  ecHsApp :: Located (b GhcPs) -> LHsExpr GhcPs -> b GhcPs
+  mkHsAppPV :: SrcSpan -> Located b -> Located (FunArg b) -> PV (Located b)
   -- | 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)
-  ecHsDo :: Located [LStmt GhcPs (Located (b GhcPs))] -> b GhcPs
+  mkHsDoPV :: SrcSpan -> Located [LStmt GhcPs (Located b)] -> PV (Located b)
   -- | 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)
-  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 "_"))
 
+-- | 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]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
@@ -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):
 
-    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:
 
@@ -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) }
 
-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 ->
@@ -2028,9 +2277,9 @@ We abstract over LHsExpr, and it becomes:
 
 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.
@@ -2316,11 +2565,80 @@ thread 'tag' explicitly:
     | ';' 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
 
@@ -2342,7 +2660,7 @@ mkRecConstrOrUpdate
         :: 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
@@ -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)
+  addWarning option srcspan msg =
+    PV $ ReaderT $ \_ -> addWarning option srcspan msg
   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.
-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)
 
-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
-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
-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
-                      (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
-    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 =
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index dd38feb3672edc7f5b9075532cacf4e242ad9fae..7b00a624034beb77e76829d96bbcdfe708d1ff41 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -140,6 +140,9 @@ rnExpr (HsVar _ (L l v))
 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
@@ -345,24 +348,6 @@ rnExpr (ArithSeq x _ seq)
            else
             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
-
 {-
 ************************************************************************
 *                                                                      *
@@ -415,9 +400,6 @@ rnExpr (HsProc x pat body)
 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)
@@ -2087,12 +2069,6 @@ sectionErr 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)
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 2a2f05eea5a0e8ca37a6a912ac26ba77262d0c41..bc307568f84dc05bfe033292f952ca3e0b19c77c 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -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 (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"
 
diff --git a/testsuite/tests/parser/should_fail/InfixAppPatErr.stderr b/testsuite/tests/parser/should_fail/InfixAppPatErr.stderr
index 69839e3920c480c801c72a0ca57f08df2f951a62..f50166fd410c7735dcee5ba254aa8bf1989e7c3d 100644
--- a/testsuite/tests/parser/should_fail/InfixAppPatErr.stderr
+++ b/testsuite/tests/parser/should_fail/InfixAppPatErr.stderr
@@ -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'?
diff --git a/testsuite/tests/parser/should_fail/T984.stderr b/testsuite/tests/parser/should_fail/T984.stderr
index 4c723a7869ae494c49784d9ca91cf4a6209ba06a..6d25a36e9e3f688227f03e0577318e9ecb65e36f 100644
--- a/testsuite/tests/parser/should_fail/T984.stderr
+++ b/testsuite/tests/parser/should_fail/T984.stderr
@@ -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'?
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index aa089de3eb004533329aa4146c6b2715b3f1f21a..2fc7f3d326aee6a8afecc1ba2a984385089a1148 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -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('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
index 0000000000000000000000000000000000000000..c5a4f2fc89e5d160c6113f5276839e4fccef7472
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail001.hs
@@ -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
index 0000000000000000000000000000000000000000..7f8210ab4b4f30bb436bbd6fc86c766c6bcf1cd2
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail001.stderr
@@ -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
index 0000000000000000000000000000000000000000..a75a4d249cfca88d90df565e07017e50a47505d5
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail002.hs
@@ -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
index 0000000000000000000000000000000000000000..1e0393346abe9108a0ad44f48ad9f743d61fb6ca
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail002.stderr
@@ -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
index 0000000000000000000000000000000000000000..03b8b823d3015d2fd094f7a204a323a9e137d4f5
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail003.hs
@@ -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
index 0000000000000000000000000000000000000000..21f958174d3ffba40acfac58f38106073b911a81
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail003.stderr
@@ -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
index 0000000000000000000000000000000000000000..89898cb9839c47efa738b0be156f673e1bc0f604
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail004.hs
@@ -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
index 0000000000000000000000000000000000000000..ed149373671a72e957d6cf5cd40cdc7c11e29a49
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail004.stderr
@@ -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
index 0000000000000000000000000000000000000000..a665ddd916fee82a3c4dde1a188b8e250ee38da7
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail005.hs
@@ -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
index 0000000000000000000000000000000000000000..9944ff277c425e896eb729dae1268e27557a80f4
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail005.stderr
@@ -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
index 0000000000000000000000000000000000000000..5953d741703485a0a0da4adefd8824632851aa15
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail006.hs
@@ -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
index 0000000000000000000000000000000000000000..ad64e916481a2485ca67c170668bc57b8abe07c7
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail006.stderr
@@ -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
index 0000000000000000000000000000000000000000..1d3c3adc17a5fbc169c133300160cd62fc8bbb53
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail007.hs
@@ -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
index 0000000000000000000000000000000000000000..82dadb6b67a636548ffee16f835ba3e504b8e121
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail007.stderr
@@ -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
index 0000000000000000000000000000000000000000..76e9864a9d04271b2e203c943a0de106ee83f888
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail008.hs
@@ -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
index 0000000000000000000000000000000000000000..0f2f0818d7eb3b2953bea8da186dcdc9db7f74d6
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail008.stderr
@@ -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
index 0000000000000000000000000000000000000000..e61ba081894027c9e1313b28cbb104f397568a39
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail009.hs
@@ -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
index 0000000000000000000000000000000000000000..a0c4af5b774bccdb45cabdecbe30d7734a9ba262
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/cmdFail009.stderr
@@ -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
index 0000000000000000000000000000000000000000..1e41ed25fe3c5ab1c3cdafa336e8a5e29aa3298a
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail001.hs
@@ -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
index 0000000000000000000000000000000000000000..6dd20d794d47d5d290030509b882e906e7b1027c
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail001.stderr
@@ -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
index 0000000000000000000000000000000000000000..b6be3c44829ed22ab1b922416ce443c697a3e54c
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail002.hs
@@ -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
index 0000000000000000000000000000000000000000..804bfe9f47250b80d9b6fdd4c9e02e98db0741d9
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail002.stderr
@@ -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
index 0000000000000000000000000000000000000000..aab9750ee8217275abaa5be910eebb0f20dd0b8a
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail003.hs
@@ -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
index 0000000000000000000000000000000000000000..dc6e7aaea00c02e6a8df55a6608c926da512d10f
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail003.stderr
@@ -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
index 0000000000000000000000000000000000000000..0bc1ada01e037f9dbd265f58549c5e7dbdb0d3f8
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail004.hs
@@ -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
index 0000000000000000000000000000000000000000..48d289c3489ba12bed0f470803a46c57a7c78aa0
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail004.stderr
@@ -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
index 0000000000000000000000000000000000000000..b140752fe9c777e13a6a066aa9ba9917256aac93
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail005.hs
@@ -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
index 0000000000000000000000000000000000000000..1302d62e0c2cd214b4b1b079fe2f160adbff8888
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail005.stderr
@@ -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
index 0000000000000000000000000000000000000000..ede9ad3a01a868e4c4cb8b84bafa9b513c890074
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail006.hs
@@ -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
index 0000000000000000000000000000000000000000..270f7381632292daeaf8081a4d6d3e46e35f044b
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail006.stderr
@@ -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
index 0000000000000000000000000000000000000000..fb6a48d4d83762024bcad637a53af84d29042723
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail007.hs
@@ -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
index 0000000000000000000000000000000000000000..f07689ba83221f5798eb0a3e367141327023d946
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail007.stderr
@@ -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
index 0000000000000000000000000000000000000000..a4b5a3b98ee782b64389ac98fa4674fc2bfd9a54
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail008.hs
@@ -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
index 0000000000000000000000000000000000000000..d9957d9ca599d5a9a171acb8b2585a43c9f5022b
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail008.stderr
@@ -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
index 0000000000000000000000000000000000000000..53e54a7d58152250bcee024ba1bb3475083f6363
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail009.hs
@@ -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
index 0000000000000000000000000000000000000000..0c9fb5de15b8104a2526c0dd7fa6451f5c6e897a
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/patFail009.stderr
@@ -0,0 +1,2 @@
+
+patFail009.hs:4:3: error: Expression syntax in pattern: #a