From a05348ebaa11d563ab2e33325055317ff3cb8afc Mon Sep 17 00:00:00 2001 From: Cale Gibbard Date: Thu, 2 Apr 2020 15:46:33 -0400 Subject: Change the fail operator argument of BindStmt to be a Maybe Don't use noSyntaxExpr for it. There is no good way to defensively case on that, nor is it clear one ought to do so. --- compiler/GHC/Hs/Expr.hs | 13 +++++++------ compiler/GHC/Hs/Utils.hs | 4 ++-- 2 files changed, 9 insertions(+), 8 deletions(-) (limited to 'compiler/GHC/Hs') diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs index f9d4c559f0..3152571508 100644 --- a/compiler/GHC/Hs/Expr.hs +++ b/compiler/GHC/Hs/Expr.hs @@ -1834,8 +1834,8 @@ data StmtLR idL idR body -- body should always be (LHs**** idR) (LPat idL) body (SyntaxExpr idR) -- The (>>=) operator; see Note [The type of bind in Stmts] - (SyntaxExpr idR) -- The fail operator - -- The fail operator is noSyntaxExpr + (Maybe (SyntaxExpr idR)) -- The fail operator + -- The fail operator is Nothing -- if the pattern match can't fail -- See Note [NoSyntaxExpr] (2) @@ -2003,13 +2003,14 @@ data ApplicativeArg idL , is_body_stmt :: Bool -- True <=> was a BodyStmt -- False <=> was a BindStmt -- See Note [Applicative BodyStmt] - , fail_operator :: (SyntaxExpr idL) -- The fail operator + , fail_operator :: Maybe (SyntaxExpr idL) -- The fail operator -- The fail operator is needed if this is a BindStmt -- where the pattern can fail. E.g.: -- (Just a) <- stmt -- The fail operator will be invoked if the pattern -- match fails. - -- The fail operator is noSyntaxExpr + -- It is also used for guards in MonadComprehensions. + -- The fail operator is Nothing -- if the pattern match can't fail -- See Note [NoSyntaxExpr] (2) } @@ -2252,7 +2253,7 @@ pprStmt (ApplicativeStmt _ args mb_join) [ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr :: ExprStmt (GhcPass idL))] | otherwise = - [ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr + [ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr Nothing :: ExprStmt (GhcPass idL))] flattenArg (_, ApplicativeArgMany _ stmts _ _) = concatMap flattenStmt stmts @@ -2278,7 +2279,7 @@ pprArg (ApplicativeArgOne _ pat expr isBody _) ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr :: ExprStmt (GhcPass idL)) | otherwise = - ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr + ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr Nothing :: ExprStmt (GhcPass idL)) pprArg (ApplicativeArgMany _ stmts return pat) = ppr pat <+> diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs index 75d9219cbf..bc21cac318 100644 --- a/compiler/GHC/Hs/Utils.hs +++ b/compiler/GHC/Hs/Utils.hs @@ -321,8 +321,8 @@ mkLastStmt body = LastStmt noExtField body Nothing noSyntaxExpr mkBodyStmt body = BodyStmt noExtField body noSyntaxExpr noSyntaxExpr mkBindStmt pat body - = BindStmt noExtField pat body noSyntaxExpr noSyntaxExpr -mkTcBindStmt pat body = BindStmt unitTy pat body noSyntaxExpr noSyntaxExpr + = BindStmt noExtField pat body noSyntaxExpr Nothing +mkTcBindStmt pat body = BindStmt unitTy pat body noSyntaxExpr Nothing -- don't use placeHolderTypeTc above, because that panics during zonking emptyRecStmt' :: forall idL idR body. IsPass idR -- cgit v1.2.1