diff options
Diffstat (limited to 'compiler/Language/Haskell/Syntax')
| -rw-r--r-- | compiler/Language/Haskell/Syntax/Expr.hs | 25 |
1 files changed, 19 insertions, 6 deletions
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs index 563505e373..2215ed1210 100644 --- a/compiler/Language/Haskell/Syntax/Expr.hs +++ b/compiler/Language/Haskell/Syntax/Expr.hs @@ -1674,7 +1674,8 @@ data HsMatchContext p | LambdaExpr -- ^Patterns of a lambda | CaseAlt -- ^Patterns and guards on a case alternative | IfAlt -- ^Guards of a multi-way if alternative - | ProcExpr -- ^Patterns of a proc + | ArrowMatchCtxt -- ^A pattern match inside arrow notation + HsArrowMatchContext | PatBindRhs -- ^A pattern binding eg [y] <- e = e | PatBindGuards -- ^Guards of pattern bindings, e.g., -- (Just b) | Just _ <- x = e @@ -1705,6 +1706,12 @@ data HsStmtContext p | TransStmtCtxt (HsStmtContext p) -- ^A branch of a transform stmt | ArrowExpr -- ^do-notation in an arrow-command context +-- | Haskell arrow match context. +data HsArrowMatchContext + = ProcExpr -- ^ A proc expression + | ArrowCaseAlt -- ^ A case alternative inside arrow notation + | KappaExpr -- ^ An arrow kappa abstraction + data HsDoFlavour = DoExpr (Maybe ModuleName) -- ^[ModuleName.]do { ... } | MDoExpr (Maybe ModuleName) -- ^[ModuleName.]mdo { ... } ie recursive do-expression @@ -1767,7 +1774,7 @@ matchSeparator (FunRhs {}) = text "=" matchSeparator CaseAlt = text "->" matchSeparator IfAlt = text "->" matchSeparator LambdaExpr = text "->" -matchSeparator ProcExpr = text "->" +matchSeparator (ArrowMatchCtxt{})= text "->" matchSeparator PatBindRhs = text "=" matchSeparator PatBindGuards = text "=" matchSeparator (StmtCtxt _) = text "<-" @@ -1783,9 +1790,10 @@ pprMatchContext ctxt | want_an ctxt = text "an" <+> pprMatchContextNoun ctxt | otherwise = text "a" <+> pprMatchContextNoun ctxt where - want_an (FunRhs {}) = True -- Use "an" in front - want_an ProcExpr = True - want_an _ = False + want_an (FunRhs {}) = True -- Use "an" in front + want_an (ArrowMatchCtxt ProcExpr) = True + want_an (ArrowMatchCtxt KappaExpr) = True + want_an _ = False pprMatchContextNoun :: forall p. (Outputable (IdP p), UnXRec p) => HsMatchContext p -> SDoc @@ -1800,11 +1808,16 @@ pprMatchContextNoun ThPatQuote = text "Template Haskell pattern quotation" pprMatchContextNoun PatBindRhs = text "pattern binding" pprMatchContextNoun PatBindGuards = text "pattern binding guards" pprMatchContextNoun LambdaExpr = text "lambda abstraction" -pprMatchContextNoun ProcExpr = text "arrow abstraction" +pprMatchContextNoun (ArrowMatchCtxt c)= pprArrowMatchContextNoun c pprMatchContextNoun (StmtCtxt ctxt) = text "pattern binding in" $$ pprAStmtContext ctxt pprMatchContextNoun PatSyn = text "pattern synonym declaration" +pprArrowMatchContextNoun :: HsArrowMatchContext -> SDoc +pprArrowMatchContextNoun ProcExpr = text "arrow proc pattern" +pprArrowMatchContextNoun ArrowCaseAlt = text "case alternative within arrow notation" +pprArrowMatchContextNoun KappaExpr = text "arrow kappa abstraction" + ----------------- pprAStmtContext, pprStmtContext :: (Outputable (IdP p), UnXRec p) => HsStmtContext p -> SDoc |