xref: /llvm-project/flang/lib/Parser/expr-parsers.cpp (revision a957cedea9657addbe8b860852cc98306aa437e7)
164ab3302SCarolineConcatto //===-- lib/Parser/expr-parsers.cpp ---------------------------------------===//
264ab3302SCarolineConcatto //
364ab3302SCarolineConcatto // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
464ab3302SCarolineConcatto // See https://llvm.org/LICENSE.txt for license information.
564ab3302SCarolineConcatto // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
664ab3302SCarolineConcatto //
764ab3302SCarolineConcatto //===----------------------------------------------------------------------===//
864ab3302SCarolineConcatto 
964ab3302SCarolineConcatto // Per-type parsers for expressions.
1064ab3302SCarolineConcatto 
1164ab3302SCarolineConcatto #include "expr-parsers.h"
1264ab3302SCarolineConcatto #include "basic-parsers.h"
1364ab3302SCarolineConcatto #include "misc-parsers.h"
1464ab3302SCarolineConcatto #include "stmt-parser.h"
1564ab3302SCarolineConcatto #include "token-parsers.h"
1664ab3302SCarolineConcatto #include "type-parser-implementation.h"
1764ab3302SCarolineConcatto #include "flang/Parser/characters.h"
1864ab3302SCarolineConcatto #include "flang/Parser/parse-tree.h"
1964ab3302SCarolineConcatto 
2064ab3302SCarolineConcatto namespace Fortran::parser {
2164ab3302SCarolineConcatto 
2264ab3302SCarolineConcatto // R764 boz-literal-constant -> binary-constant | octal-constant | hex-constant
2364ab3302SCarolineConcatto // R765 binary-constant -> B ' digit [digit]... ' | B " digit [digit]... "
2464ab3302SCarolineConcatto // R766 octal-constant -> O ' digit [digit]... ' | O " digit [digit]... "
2564ab3302SCarolineConcatto // R767 hex-constant ->
2664ab3302SCarolineConcatto //        Z ' hex-digit [hex-digit]... ' | Z " hex-digit [hex-digit]... "
2764ab3302SCarolineConcatto // extension: X accepted for Z
2864ab3302SCarolineConcatto // extension: BOZX suffix accepted
2964ab3302SCarolineConcatto TYPE_PARSER(construct<BOZLiteralConstant>(BOZLiteral{}))
3064ab3302SCarolineConcatto 
3164ab3302SCarolineConcatto // R769 array-constructor -> (/ ac-spec /) | lbracket ac-spec rbracket
3264ab3302SCarolineConcatto TYPE_CONTEXT_PARSER("array constructor"_en_US,
3364ab3302SCarolineConcatto     construct<ArrayConstructor>(
3464ab3302SCarolineConcatto         "(/" >> Parser<AcSpec>{} / "/)" || bracketed(Parser<AcSpec>{})))
3564ab3302SCarolineConcatto 
3664ab3302SCarolineConcatto // R770 ac-spec -> type-spec :: | [type-spec ::] ac-value-list
3764ab3302SCarolineConcatto TYPE_PARSER(construct<AcSpec>(maybe(typeSpec / "::"),
3864ab3302SCarolineConcatto                 nonemptyList("expected array constructor values"_err_en_US,
3964ab3302SCarolineConcatto                     Parser<AcValue>{})) ||
4064ab3302SCarolineConcatto     construct<AcSpec>(typeSpec / "::"))
4164ab3302SCarolineConcatto 
4264ab3302SCarolineConcatto // R773 ac-value -> expr | ac-implied-do
4364ab3302SCarolineConcatto TYPE_PARSER(
4464ab3302SCarolineConcatto     // PGI/Intel extension: accept triplets in array constructors
4564ab3302SCarolineConcatto     extension<LanguageFeature::TripletInArrayConstructor>(
462d8b6a47SPeter Klausler         "nonstandard usage: triplet in array constructor"_port_en_US,
4764ab3302SCarolineConcatto         construct<AcValue>(construct<AcValue::Triplet>(scalarIntExpr,
4864ab3302SCarolineConcatto             ":" >> scalarIntExpr, maybe(":" >> scalarIntExpr)))) ||
4964ab3302SCarolineConcatto     construct<AcValue>(indirect(expr)) ||
5064ab3302SCarolineConcatto     construct<AcValue>(indirect(Parser<AcImpliedDo>{})))
5164ab3302SCarolineConcatto 
5264ab3302SCarolineConcatto // R774 ac-implied-do -> ( ac-value-list , ac-implied-do-control )
5364ab3302SCarolineConcatto TYPE_PARSER(parenthesized(
5464ab3302SCarolineConcatto     construct<AcImpliedDo>(nonemptyList(Parser<AcValue>{} / lookAhead(","_tok)),
5564ab3302SCarolineConcatto         "," >> Parser<AcImpliedDoControl>{})))
5664ab3302SCarolineConcatto 
5764ab3302SCarolineConcatto // R775 ac-implied-do-control ->
5864ab3302SCarolineConcatto //        [integer-type-spec ::] ac-do-variable = scalar-int-expr ,
5964ab3302SCarolineConcatto //        scalar-int-expr [, scalar-int-expr]
6064ab3302SCarolineConcatto // R776 ac-do-variable -> do-variable
6164ab3302SCarolineConcatto TYPE_PARSER(construct<AcImpliedDoControl>(
6264ab3302SCarolineConcatto     maybe(integerTypeSpec / "::"), loopBounds(scalarIntExpr)))
6364ab3302SCarolineConcatto 
6464ab3302SCarolineConcatto // R1001 primary ->
6564ab3302SCarolineConcatto //         literal-constant | designator | array-constructor |
6664ab3302SCarolineConcatto //         structure-constructor | function-reference | type-param-inquiry |
6764ab3302SCarolineConcatto //         type-param-name | ( expr )
68e03664d4SPeter Klausler // type-param-inquiry is parsed as a structure component, except for
69e03664d4SPeter Klausler // substring%KIND/LEN
7064ab3302SCarolineConcatto constexpr auto primary{instrumented("primary"_en_US,
71*a957cedeSPeter Klausler     first(construct<Expr>(indirect(charLiteralConstantSubstring)),
7264ab3302SCarolineConcatto         construct<Expr>(literalConstant),
73010c55bfSPeter Klausler         construct<Expr>(construct<Expr::Parentheses>("(" >>
74010c55bfSPeter Klausler             expr / !","_tok / recovery(")"_tok, SkipPastNested<'(', ')'>{}))),
75e03664d4SPeter Klausler         construct<Expr>(indirect(functionReference) / !"("_tok / !"%"_tok),
76e03664d4SPeter Klausler         construct<Expr>(designator / !"("_tok / !"%"_tok),
77e03664d4SPeter Klausler         construct<Expr>(indirect(Parser<SubstringInquiry>{})), // %LEN or %KIND
7864ab3302SCarolineConcatto         construct<Expr>(Parser<StructureConstructor>{}),
7964ab3302SCarolineConcatto         construct<Expr>(Parser<ArrayConstructor>{}),
8064ab3302SCarolineConcatto         // PGI/XLF extension: COMPLEX constructor (x,y)
8164ab3302SCarolineConcatto         construct<Expr>(parenthesized(
821c91d9bdSPeter Klausler             construct<Expr::ComplexConstructor>(expr, "," >> expr))),
832d8b6a47SPeter Klausler         extension<LanguageFeature::PercentLOC>(
842d8b6a47SPeter Klausler             "nonstandard usage: %LOC"_port_en_US,
852d8b6a47SPeter Klausler             construct<Expr>("%LOC" >> parenthesized(construct<Expr::PercentLoc>(
862d8b6a47SPeter Klausler                                           indirect(variable)))))))};
8764ab3302SCarolineConcatto 
8864ab3302SCarolineConcatto // R1002 level-1-expr -> [defined-unary-op] primary
8964ab3302SCarolineConcatto // TODO: Reasonable extension: permit multiple defined-unary-ops
9064ab3302SCarolineConcatto constexpr auto level1Expr{sourced(
9168f4e46cSPeter Klausler     primary || // must come before define op to resolve .TRUE._8 ambiguity
9268f4e46cSPeter Klausler     construct<Expr>(construct<Expr::DefinedUnary>(definedOpName, primary)))};
9364ab3302SCarolineConcatto 
9464ab3302SCarolineConcatto // R1004 mult-operand -> level-1-expr [power-op mult-operand]
9564ab3302SCarolineConcatto // R1007 power-op -> **
9664ab3302SCarolineConcatto // Exponentiation (**) is Fortran's only right-associative binary operation.
9764ab3302SCarolineConcatto struct MultOperand {
9864ab3302SCarolineConcatto   using resultType = Expr;
9964ab3302SCarolineConcatto   constexpr MultOperand() {}
10064ab3302SCarolineConcatto   static inline std::optional<Expr> Parse(ParseState &);
10164ab3302SCarolineConcatto };
10264ab3302SCarolineConcatto 
10368f4e46cSPeter Klausler // Extension: allow + or - before a mult-operand
10468f4e46cSPeter Klausler // Such a unary operand has lower precedence than exponentiation,
10568f4e46cSPeter Klausler // so -x**2 is -(x**2), not (-x)**2; this matches all other
10668f4e46cSPeter Klausler // compilers with this extension.
10768f4e46cSPeter Klausler static constexpr auto standardMultOperand{sourced(MultOperand{})};
10868f4e46cSPeter Klausler static constexpr auto multOperand{standardMultOperand ||
10968f4e46cSPeter Klausler     extension<LanguageFeature::SignedMultOperand>(
11068f4e46cSPeter Klausler         "nonstandard usage: signed mult-operand"_port_en_US,
11168f4e46cSPeter Klausler         construct<Expr>(
11268f4e46cSPeter Klausler             construct<Expr::UnaryPlus>("+" >> standardMultOperand))) ||
11368f4e46cSPeter Klausler     extension<LanguageFeature::SignedMultOperand>(
11468f4e46cSPeter Klausler         "nonstandard usage: signed mult-operand"_port_en_US,
11568f4e46cSPeter Klausler         construct<Expr>(construct<Expr::Negate>("-" >> standardMultOperand)))};
11664ab3302SCarolineConcatto 
11764ab3302SCarolineConcatto inline std::optional<Expr> MultOperand::Parse(ParseState &state) {
11864ab3302SCarolineConcatto   std::optional<Expr> result{level1Expr.Parse(state)};
11964ab3302SCarolineConcatto   if (result) {
12064ab3302SCarolineConcatto     static constexpr auto op{attempt("**"_tok)};
12164ab3302SCarolineConcatto     if (op.Parse(state)) {
12264ab3302SCarolineConcatto       std::function<Expr(Expr &&)> power{[&result](Expr &&right) {
12364ab3302SCarolineConcatto         return Expr{Expr::Power(std::move(result).value(), std::move(right))};
12464ab3302SCarolineConcatto       }};
12564ab3302SCarolineConcatto       return applyLambda(power, multOperand).Parse(state); // right-recursive
12664ab3302SCarolineConcatto     }
12764ab3302SCarolineConcatto   }
12864ab3302SCarolineConcatto   return result;
12964ab3302SCarolineConcatto }
13064ab3302SCarolineConcatto 
13164ab3302SCarolineConcatto // R1005 add-operand -> [add-operand mult-op] mult-operand
13264ab3302SCarolineConcatto // R1008 mult-op -> * | /
13364ab3302SCarolineConcatto // The left recursion in the grammar is implemented iteratively.
134207d4499SMichael Kruse struct AddOperand {
13564ab3302SCarolineConcatto   using resultType = Expr;
13664ab3302SCarolineConcatto   constexpr AddOperand() {}
13764ab3302SCarolineConcatto   static inline std::optional<Expr> Parse(ParseState &state) {
13864ab3302SCarolineConcatto     std::optional<Expr> result{multOperand.Parse(state)};
13964ab3302SCarolineConcatto     if (result) {
14064ab3302SCarolineConcatto       auto source{result->source};
14164ab3302SCarolineConcatto       std::function<Expr(Expr &&)> multiply{[&result](Expr &&right) {
14264ab3302SCarolineConcatto         return Expr{
14364ab3302SCarolineConcatto             Expr::Multiply(std::move(result).value(), std::move(right))};
14464ab3302SCarolineConcatto       }};
14564ab3302SCarolineConcatto       std::function<Expr(Expr &&)> divide{[&result](Expr &&right) {
14664ab3302SCarolineConcatto         return Expr{Expr::Divide(std::move(result).value(), std::move(right))};
14764ab3302SCarolineConcatto       }};
14864ab3302SCarolineConcatto       auto more{attempt(sourced("*" >> applyLambda(multiply, multOperand) ||
14964ab3302SCarolineConcatto           "/" >> applyLambda(divide, multOperand)))};
15064ab3302SCarolineConcatto       while (std::optional<Expr> next{more.Parse(state)}) {
15164ab3302SCarolineConcatto         result = std::move(next);
15264ab3302SCarolineConcatto         result->source.ExtendToCover(source);
15364ab3302SCarolineConcatto       }
15464ab3302SCarolineConcatto     }
15564ab3302SCarolineConcatto     return result;
15664ab3302SCarolineConcatto   }
157207d4499SMichael Kruse };
158207d4499SMichael Kruse constexpr AddOperand addOperand;
15964ab3302SCarolineConcatto 
16064ab3302SCarolineConcatto // R1006 level-2-expr -> [[level-2-expr] add-op] add-operand
16164ab3302SCarolineConcatto // R1009 add-op -> + | -
16264ab3302SCarolineConcatto // These are left-recursive productions, implemented iteratively.
16364ab3302SCarolineConcatto // Note that standard Fortran admits a unary + or - to appear only here,
16464ab3302SCarolineConcatto // by means of a missing first operand; e.g., 2*-3 is valid in C but not
16564ab3302SCarolineConcatto // standard Fortran.  We accept unary + and - to appear before any primary
16664ab3302SCarolineConcatto // as an extension.
167207d4499SMichael Kruse struct Level2Expr {
16864ab3302SCarolineConcatto   using resultType = Expr;
16964ab3302SCarolineConcatto   constexpr Level2Expr() {}
17064ab3302SCarolineConcatto   static inline std::optional<Expr> Parse(ParseState &state) {
17164ab3302SCarolineConcatto     static constexpr auto unary{
17264ab3302SCarolineConcatto         sourced(
17364ab3302SCarolineConcatto             construct<Expr>(construct<Expr::UnaryPlus>("+" >> addOperand)) ||
17464ab3302SCarolineConcatto             construct<Expr>(construct<Expr::Negate>("-" >> addOperand))) ||
17564ab3302SCarolineConcatto         addOperand};
17664ab3302SCarolineConcatto     std::optional<Expr> result{unary.Parse(state)};
17764ab3302SCarolineConcatto     if (result) {
17864ab3302SCarolineConcatto       auto source{result->source};
17964ab3302SCarolineConcatto       std::function<Expr(Expr &&)> add{[&result](Expr &&right) {
18064ab3302SCarolineConcatto         return Expr{Expr::Add(std::move(result).value(), std::move(right))};
18164ab3302SCarolineConcatto       }};
18264ab3302SCarolineConcatto       std::function<Expr(Expr &&)> subtract{[&result](Expr &&right) {
18364ab3302SCarolineConcatto         return Expr{
18464ab3302SCarolineConcatto             Expr::Subtract(std::move(result).value(), std::move(right))};
18564ab3302SCarolineConcatto       }};
18664ab3302SCarolineConcatto       auto more{attempt(sourced("+" >> applyLambda(add, addOperand) ||
18764ab3302SCarolineConcatto           "-" >> applyLambda(subtract, addOperand)))};
18864ab3302SCarolineConcatto       while (std::optional<Expr> next{more.Parse(state)}) {
18964ab3302SCarolineConcatto         result = std::move(next);
19064ab3302SCarolineConcatto         result->source.ExtendToCover(source);
19164ab3302SCarolineConcatto       }
19264ab3302SCarolineConcatto     }
19364ab3302SCarolineConcatto     return result;
19464ab3302SCarolineConcatto   }
195207d4499SMichael Kruse };
196207d4499SMichael Kruse constexpr Level2Expr level2Expr;
19764ab3302SCarolineConcatto 
19864ab3302SCarolineConcatto // R1010 level-3-expr -> [level-3-expr concat-op] level-2-expr
19964ab3302SCarolineConcatto // R1011 concat-op -> //
20064ab3302SCarolineConcatto // Concatenation (//) is left-associative for parsing performance, although
20164ab3302SCarolineConcatto // one would never notice if it were right-associated.
202207d4499SMichael Kruse struct Level3Expr {
20364ab3302SCarolineConcatto   using resultType = Expr;
20464ab3302SCarolineConcatto   constexpr Level3Expr() {}
20564ab3302SCarolineConcatto   static inline std::optional<Expr> Parse(ParseState &state) {
20664ab3302SCarolineConcatto     std::optional<Expr> result{level2Expr.Parse(state)};
20764ab3302SCarolineConcatto     if (result) {
20864ab3302SCarolineConcatto       auto source{result->source};
20964ab3302SCarolineConcatto       std::function<Expr(Expr &&)> concat{[&result](Expr &&right) {
21064ab3302SCarolineConcatto         return Expr{Expr::Concat(std::move(result).value(), std::move(right))};
21164ab3302SCarolineConcatto       }};
21264ab3302SCarolineConcatto       auto more{attempt(sourced("//" >> applyLambda(concat, level2Expr)))};
21364ab3302SCarolineConcatto       while (std::optional<Expr> next{more.Parse(state)}) {
21464ab3302SCarolineConcatto         result = std::move(next);
21564ab3302SCarolineConcatto         result->source.ExtendToCover(source);
21664ab3302SCarolineConcatto       }
21764ab3302SCarolineConcatto     }
21864ab3302SCarolineConcatto     return result;
21964ab3302SCarolineConcatto   }
220207d4499SMichael Kruse };
221207d4499SMichael Kruse constexpr Level3Expr level3Expr;
22264ab3302SCarolineConcatto 
22364ab3302SCarolineConcatto // R1012 level-4-expr -> [level-3-expr rel-op] level-3-expr
22464ab3302SCarolineConcatto // R1013 rel-op ->
22564ab3302SCarolineConcatto //         .EQ. | .NE. | .LT. | .LE. | .GT. | .GE. |
22664ab3302SCarolineConcatto //          == | /= | < | <= | > | >=  @ | <>
22764ab3302SCarolineConcatto // N.B. relations are not recursive (i.e., LOGICAL is not ordered)
228207d4499SMichael Kruse struct Level4Expr {
22964ab3302SCarolineConcatto   using resultType = Expr;
23064ab3302SCarolineConcatto   constexpr Level4Expr() {}
23164ab3302SCarolineConcatto   static inline std::optional<Expr> Parse(ParseState &state) {
23264ab3302SCarolineConcatto     std::optional<Expr> result{level3Expr.Parse(state)};
23364ab3302SCarolineConcatto     if (result) {
23464ab3302SCarolineConcatto       auto source{result->source};
23564ab3302SCarolineConcatto       std::function<Expr(Expr &&)> lt{[&result](Expr &&right) {
23664ab3302SCarolineConcatto         return Expr{Expr::LT(std::move(result).value(), std::move(right))};
23764ab3302SCarolineConcatto       }};
23864ab3302SCarolineConcatto       std::function<Expr(Expr &&)> le{[&result](Expr &&right) {
23964ab3302SCarolineConcatto         return Expr{Expr::LE(std::move(result).value(), std::move(right))};
24064ab3302SCarolineConcatto       }};
24164ab3302SCarolineConcatto       std::function<Expr(Expr &&)> eq{[&result](Expr &&right) {
24264ab3302SCarolineConcatto         return Expr{Expr::EQ(std::move(result).value(), std::move(right))};
24364ab3302SCarolineConcatto       }};
24464ab3302SCarolineConcatto       std::function<Expr(Expr &&)> ne{[&result](Expr &&right) {
24564ab3302SCarolineConcatto         return Expr{Expr::NE(std::move(result).value(), std::move(right))};
24664ab3302SCarolineConcatto       }};
24764ab3302SCarolineConcatto       std::function<Expr(Expr &&)> ge{[&result](Expr &&right) {
24864ab3302SCarolineConcatto         return Expr{Expr::GE(std::move(result).value(), std::move(right))};
24964ab3302SCarolineConcatto       }};
25064ab3302SCarolineConcatto       std::function<Expr(Expr &&)> gt{[&result](Expr &&right) {
25164ab3302SCarolineConcatto         return Expr{Expr::GT(std::move(result).value(), std::move(right))};
25264ab3302SCarolineConcatto       }};
25364ab3302SCarolineConcatto       auto more{attempt(
25464ab3302SCarolineConcatto           sourced((".LT."_tok || "<"_tok) >> applyLambda(lt, level3Expr) ||
25564ab3302SCarolineConcatto               (".LE."_tok || "<="_tok) >> applyLambda(le, level3Expr) ||
25664ab3302SCarolineConcatto               (".EQ."_tok || "=="_tok) >> applyLambda(eq, level3Expr) ||
25764ab3302SCarolineConcatto               (".NE."_tok || "/="_tok ||
25864ab3302SCarolineConcatto                   extension<LanguageFeature::AlternativeNE>(
2592d8b6a47SPeter Klausler                       "nonstandard usage: <> for /= or .NE."_port_en_US,
26064ab3302SCarolineConcatto                       "<>"_tok /* PGI/Cray extension; Cray also has .LG. */)) >>
26164ab3302SCarolineConcatto                   applyLambda(ne, level3Expr) ||
26264ab3302SCarolineConcatto               (".GE."_tok || ">="_tok) >> applyLambda(ge, level3Expr) ||
26364ab3302SCarolineConcatto               (".GT."_tok || ">"_tok) >> applyLambda(gt, level3Expr)))};
26464ab3302SCarolineConcatto       if (std::optional<Expr> next{more.Parse(state)}) {
26564ab3302SCarolineConcatto         next->source.ExtendToCover(source);
26664ab3302SCarolineConcatto         return next;
26764ab3302SCarolineConcatto       }
26864ab3302SCarolineConcatto     }
26964ab3302SCarolineConcatto     return result;
27064ab3302SCarolineConcatto   }
271207d4499SMichael Kruse };
272207d4499SMichael Kruse constexpr Level4Expr level4Expr;
27364ab3302SCarolineConcatto 
27464ab3302SCarolineConcatto // R1014 and-operand -> [not-op] level-4-expr
27564ab3302SCarolineConcatto // R1018 not-op -> .NOT.
27664ab3302SCarolineConcatto // N.B. Fortran's .NOT. binds less tightly than its comparison operators do.
27764ab3302SCarolineConcatto // PGI/Intel extension: accept multiple .NOT. operators
278207d4499SMichael Kruse struct AndOperand {
27964ab3302SCarolineConcatto   using resultType = Expr;
28064ab3302SCarolineConcatto   constexpr AndOperand() {}
28164ab3302SCarolineConcatto   static inline std::optional<Expr> Parse(ParseState &);
282207d4499SMichael Kruse };
283207d4499SMichael Kruse constexpr AndOperand andOperand;
28464ab3302SCarolineConcatto 
28564ab3302SCarolineConcatto // Match a logical operator or, optionally, its abbreviation.
28664ab3302SCarolineConcatto inline constexpr auto logicalOp(const char *op, const char *abbrev) {
28764ab3302SCarolineConcatto   return TokenStringMatch{op} ||
28864ab3302SCarolineConcatto       extension<LanguageFeature::LogicalAbbreviations>(
2892d8b6a47SPeter Klausler           "nonstandard usage: abbreviated LOGICAL operator"_port_en_US,
29064ab3302SCarolineConcatto           TokenStringMatch{abbrev});
29164ab3302SCarolineConcatto }
29264ab3302SCarolineConcatto 
29364ab3302SCarolineConcatto inline std::optional<Expr> AndOperand::Parse(ParseState &state) {
29464ab3302SCarolineConcatto   static constexpr auto notOp{attempt(logicalOp(".NOT.", ".N.") >> andOperand)};
29564ab3302SCarolineConcatto   if (std::optional<Expr> negation{notOp.Parse(state)}) {
29664ab3302SCarolineConcatto     return Expr{Expr::NOT{std::move(*negation)}};
29764ab3302SCarolineConcatto   } else {
29864ab3302SCarolineConcatto     return level4Expr.Parse(state);
29964ab3302SCarolineConcatto   }
30064ab3302SCarolineConcatto }
30164ab3302SCarolineConcatto 
30264ab3302SCarolineConcatto // R1015 or-operand -> [or-operand and-op] and-operand
30364ab3302SCarolineConcatto // R1019 and-op -> .AND.
30464ab3302SCarolineConcatto // .AND. is left-associative
305207d4499SMichael Kruse struct OrOperand {
30664ab3302SCarolineConcatto   using resultType = Expr;
30764ab3302SCarolineConcatto   constexpr OrOperand() {}
30864ab3302SCarolineConcatto   static inline std::optional<Expr> Parse(ParseState &state) {
30964ab3302SCarolineConcatto     static constexpr auto operand{sourced(andOperand)};
31064ab3302SCarolineConcatto     std::optional<Expr> result{operand.Parse(state)};
31164ab3302SCarolineConcatto     if (result) {
31264ab3302SCarolineConcatto       auto source{result->source};
31364ab3302SCarolineConcatto       std::function<Expr(Expr &&)> logicalAnd{[&result](Expr &&right) {
31464ab3302SCarolineConcatto         return Expr{Expr::AND(std::move(result).value(), std::move(right))};
31564ab3302SCarolineConcatto       }};
31664ab3302SCarolineConcatto       auto more{attempt(sourced(
31764ab3302SCarolineConcatto           logicalOp(".AND.", ".A.") >> applyLambda(logicalAnd, andOperand)))};
31864ab3302SCarolineConcatto       while (std::optional<Expr> next{more.Parse(state)}) {
31964ab3302SCarolineConcatto         result = std::move(next);
32064ab3302SCarolineConcatto         result->source.ExtendToCover(source);
32164ab3302SCarolineConcatto       }
32264ab3302SCarolineConcatto     }
32364ab3302SCarolineConcatto     return result;
32464ab3302SCarolineConcatto   }
325207d4499SMichael Kruse };
326207d4499SMichael Kruse constexpr OrOperand orOperand;
32764ab3302SCarolineConcatto 
32864ab3302SCarolineConcatto // R1016 equiv-operand -> [equiv-operand or-op] or-operand
32964ab3302SCarolineConcatto // R1020 or-op -> .OR.
33064ab3302SCarolineConcatto // .OR. is left-associative
331207d4499SMichael Kruse struct EquivOperand {
33264ab3302SCarolineConcatto   using resultType = Expr;
33364ab3302SCarolineConcatto   constexpr EquivOperand() {}
33464ab3302SCarolineConcatto   static inline std::optional<Expr> Parse(ParseState &state) {
33564ab3302SCarolineConcatto     std::optional<Expr> result{orOperand.Parse(state)};
33664ab3302SCarolineConcatto     if (result) {
33764ab3302SCarolineConcatto       auto source{result->source};
33864ab3302SCarolineConcatto       std::function<Expr(Expr &&)> logicalOr{[&result](Expr &&right) {
33964ab3302SCarolineConcatto         return Expr{Expr::OR(std::move(result).value(), std::move(right))};
34064ab3302SCarolineConcatto       }};
34164ab3302SCarolineConcatto       auto more{attempt(sourced(
34264ab3302SCarolineConcatto           logicalOp(".OR.", ".O.") >> applyLambda(logicalOr, orOperand)))};
34364ab3302SCarolineConcatto       while (std::optional<Expr> next{more.Parse(state)}) {
34464ab3302SCarolineConcatto         result = std::move(next);
34564ab3302SCarolineConcatto         result->source.ExtendToCover(source);
34664ab3302SCarolineConcatto       }
34764ab3302SCarolineConcatto     }
34864ab3302SCarolineConcatto     return result;
34964ab3302SCarolineConcatto   }
350207d4499SMichael Kruse };
351207d4499SMichael Kruse constexpr EquivOperand equivOperand;
35264ab3302SCarolineConcatto 
35364ab3302SCarolineConcatto // R1017 level-5-expr -> [level-5-expr equiv-op] equiv-operand
35464ab3302SCarolineConcatto // R1021 equiv-op -> .EQV. | .NEQV.
35564ab3302SCarolineConcatto // Logical equivalence is left-associative.
35664ab3302SCarolineConcatto // Extension: .XOR. as synonym for .NEQV.
357207d4499SMichael Kruse struct Level5Expr {
35864ab3302SCarolineConcatto   using resultType = Expr;
35964ab3302SCarolineConcatto   constexpr Level5Expr() {}
36064ab3302SCarolineConcatto   static inline std::optional<Expr> Parse(ParseState &state) {
36164ab3302SCarolineConcatto     std::optional<Expr> result{equivOperand.Parse(state)};
36264ab3302SCarolineConcatto     if (result) {
36364ab3302SCarolineConcatto       auto source{result->source};
36464ab3302SCarolineConcatto       std::function<Expr(Expr &&)> eqv{[&result](Expr &&right) {
36564ab3302SCarolineConcatto         return Expr{Expr::EQV(std::move(result).value(), std::move(right))};
36664ab3302SCarolineConcatto       }};
36764ab3302SCarolineConcatto       std::function<Expr(Expr &&)> neqv{[&result](Expr &&right) {
36864ab3302SCarolineConcatto         return Expr{Expr::NEQV(std::move(result).value(), std::move(right))};
36964ab3302SCarolineConcatto       }};
37064ab3302SCarolineConcatto       auto more{attempt(sourced(".EQV." >> applyLambda(eqv, equivOperand) ||
37164ab3302SCarolineConcatto           (".NEQV."_tok ||
37264ab3302SCarolineConcatto               extension<LanguageFeature::XOROperator>(
3732d8b6a47SPeter Klausler                   "nonstandard usage: .XOR./.X. spelling of .NEQV."_port_en_US,
37464ab3302SCarolineConcatto                   logicalOp(".XOR.", ".X."))) >>
37564ab3302SCarolineConcatto               applyLambda(neqv, equivOperand)))};
37664ab3302SCarolineConcatto       while (std::optional<Expr> next{more.Parse(state)}) {
37764ab3302SCarolineConcatto         result = std::move(next);
37864ab3302SCarolineConcatto         result->source.ExtendToCover(source);
37964ab3302SCarolineConcatto       }
38064ab3302SCarolineConcatto     }
38164ab3302SCarolineConcatto     return result;
38264ab3302SCarolineConcatto   }
383207d4499SMichael Kruse };
384207d4499SMichael Kruse constexpr Level5Expr level5Expr;
38564ab3302SCarolineConcatto 
38664ab3302SCarolineConcatto // R1022 expr -> [expr defined-binary-op] level-5-expr
38764ab3302SCarolineConcatto // Defined binary operators associate leftwards.
38864ab3302SCarolineConcatto template <> std::optional<Expr> Parser<Expr>::Parse(ParseState &state) {
38964ab3302SCarolineConcatto   std::optional<Expr> result{level5Expr.Parse(state)};
39064ab3302SCarolineConcatto   if (result) {
39164ab3302SCarolineConcatto     auto source{result->source};
39264ab3302SCarolineConcatto     std::function<Expr(DefinedOpName &&, Expr &&)> defBinOp{
39364ab3302SCarolineConcatto         [&result](DefinedOpName &&op, Expr &&right) {
39464ab3302SCarolineConcatto           return Expr{Expr::DefinedBinary(
39564ab3302SCarolineConcatto               std::move(op), std::move(result).value(), std::move(right))};
39664ab3302SCarolineConcatto         }};
39797ca41e1SMichael Kruse     auto more{attempt(
39897ca41e1SMichael Kruse         sourced(applyLambda<Expr>(defBinOp, definedOpName, level5Expr)))};
39964ab3302SCarolineConcatto     while (std::optional<Expr> next{more.Parse(state)}) {
40064ab3302SCarolineConcatto       result = std::move(next);
40164ab3302SCarolineConcatto       result->source.ExtendToCover(source);
40264ab3302SCarolineConcatto     }
40364ab3302SCarolineConcatto   }
40464ab3302SCarolineConcatto   return result;
40564ab3302SCarolineConcatto }
40664ab3302SCarolineConcatto 
40764ab3302SCarolineConcatto // R1003 defined-unary-op -> . letter [letter]... .
40864ab3302SCarolineConcatto // R1023 defined-binary-op -> . letter [letter]... .
40964ab3302SCarolineConcatto // R1414 local-defined-operator -> defined-unary-op | defined-binary-op
41064ab3302SCarolineConcatto // R1415 use-defined-operator -> defined-unary-op | defined-binary-op
41164ab3302SCarolineConcatto // C1003 A defined operator must be distinct from logical literal constants
41264ab3302SCarolineConcatto // and intrinsic operator names; this is handled by attempting their parses
41364ab3302SCarolineConcatto // first, and by name resolution on their definitions, for best errors.
41464ab3302SCarolineConcatto // N.B. The name of the operator is captured with the dots around it.
4152d8b6a47SPeter Klausler constexpr auto definedOpNameChar{letter ||
4162d8b6a47SPeter Klausler     extension<LanguageFeature::PunctuationInNames>(
4172d8b6a47SPeter Klausler         "nonstandard usage: non-alphabetic character in defined operator"_port_en_US,
4182d8b6a47SPeter Klausler         "$@"_ch)};
41964ab3302SCarolineConcatto TYPE_PARSER(
42064ab3302SCarolineConcatto     space >> construct<DefinedOpName>(sourced("."_ch >>
42164ab3302SCarolineConcatto                  some(definedOpNameChar) >> construct<Name>() / "."_ch)))
42264ab3302SCarolineConcatto 
42364ab3302SCarolineConcatto // R1028 specification-expr -> scalar-int-expr
42464ab3302SCarolineConcatto TYPE_PARSER(construct<SpecificationExpr>(scalarIntExpr))
42564ab3302SCarolineConcatto 
42664ab3302SCarolineConcatto // R1032 assignment-stmt -> variable = expr
42764ab3302SCarolineConcatto TYPE_CONTEXT_PARSER("assignment statement"_en_US,
42864ab3302SCarolineConcatto     construct<AssignmentStmt>(variable / "=", expr))
42964ab3302SCarolineConcatto 
43064ab3302SCarolineConcatto // R1033 pointer-assignment-stmt ->
43164ab3302SCarolineConcatto //         data-pointer-object [( bounds-spec-list )] => data-target |
43264ab3302SCarolineConcatto //         data-pointer-object ( bounds-remapping-list ) => data-target |
43364ab3302SCarolineConcatto //         proc-pointer-object => proc-target
43464ab3302SCarolineConcatto // R1034 data-pointer-object ->
43564ab3302SCarolineConcatto //         variable-name | scalar-variable % data-pointer-component-name
43664ab3302SCarolineConcatto //   C1022 a scalar-variable shall be a data-ref
43764ab3302SCarolineConcatto //   C1024 a data-pointer-object shall not be a coindexed object
43864ab3302SCarolineConcatto // R1038 proc-pointer-object -> proc-pointer-name | proc-component-ref
43964ab3302SCarolineConcatto //
44064ab3302SCarolineConcatto // A distinction can't be made at the time of the initial parse between
44164ab3302SCarolineConcatto // data-pointer-object and proc-pointer-object, or between data-target
44264ab3302SCarolineConcatto // and proc-target.
44364ab3302SCarolineConcatto TYPE_CONTEXT_PARSER("pointer assignment statement"_en_US,
44464ab3302SCarolineConcatto     construct<PointerAssignmentStmt>(dataRef,
44564ab3302SCarolineConcatto         parenthesized(nonemptyList(Parser<BoundsRemapping>{})), "=>" >> expr) ||
44664ab3302SCarolineConcatto         construct<PointerAssignmentStmt>(dataRef,
44764ab3302SCarolineConcatto             defaulted(parenthesized(nonemptyList(Parser<BoundsSpec>{}))),
44864ab3302SCarolineConcatto             "=>" >> expr))
44964ab3302SCarolineConcatto 
45064ab3302SCarolineConcatto // R1035 bounds-spec -> lower-bound-expr :
45164ab3302SCarolineConcatto TYPE_PARSER(construct<BoundsSpec>(boundExpr / ":"))
45264ab3302SCarolineConcatto 
45364ab3302SCarolineConcatto // R1036 bounds-remapping -> lower-bound-expr : upper-bound-expr
45464ab3302SCarolineConcatto TYPE_PARSER(construct<BoundsRemapping>(boundExpr / ":", boundExpr))
45564ab3302SCarolineConcatto 
45664ab3302SCarolineConcatto // R1039 proc-component-ref -> scalar-variable % procedure-component-name
45764ab3302SCarolineConcatto //   C1027 the scalar-variable must be a data-ref without coindices.
45864ab3302SCarolineConcatto TYPE_PARSER(construct<ProcComponentRef>(structureComponent))
45964ab3302SCarolineConcatto 
46064ab3302SCarolineConcatto // R1041 where-stmt -> WHERE ( mask-expr ) where-assignment-stmt
46164ab3302SCarolineConcatto // R1045 where-assignment-stmt -> assignment-stmt
46264ab3302SCarolineConcatto // R1046 mask-expr -> logical-expr
46364ab3302SCarolineConcatto TYPE_CONTEXT_PARSER("WHERE statement"_en_US,
46464ab3302SCarolineConcatto     construct<WhereStmt>("WHERE" >> parenthesized(logicalExpr), assignmentStmt))
46564ab3302SCarolineConcatto 
46664ab3302SCarolineConcatto // R1042 where-construct ->
46764ab3302SCarolineConcatto //         where-construct-stmt [where-body-construct]...
46864ab3302SCarolineConcatto //         [masked-elsewhere-stmt [where-body-construct]...]...
46964ab3302SCarolineConcatto //         [elsewhere-stmt [where-body-construct]...] end-where-stmt
47064ab3302SCarolineConcatto TYPE_CONTEXT_PARSER("WHERE construct"_en_US,
47164ab3302SCarolineConcatto     construct<WhereConstruct>(statement(Parser<WhereConstructStmt>{}),
47264ab3302SCarolineConcatto         many(whereBodyConstruct),
47364ab3302SCarolineConcatto         many(construct<WhereConstruct::MaskedElsewhere>(
47464ab3302SCarolineConcatto             statement(Parser<MaskedElsewhereStmt>{}),
47564ab3302SCarolineConcatto             many(whereBodyConstruct))),
47664ab3302SCarolineConcatto         maybe(construct<WhereConstruct::Elsewhere>(
47764ab3302SCarolineConcatto             statement(Parser<ElsewhereStmt>{}), many(whereBodyConstruct))),
47864ab3302SCarolineConcatto         statement(Parser<EndWhereStmt>{})))
47964ab3302SCarolineConcatto 
48064ab3302SCarolineConcatto // R1043 where-construct-stmt -> [where-construct-name :] WHERE ( mask-expr )
48164ab3302SCarolineConcatto TYPE_CONTEXT_PARSER("WHERE construct statement"_en_US,
48264ab3302SCarolineConcatto     construct<WhereConstructStmt>(
48364ab3302SCarolineConcatto         maybe(name / ":"), "WHERE" >> parenthesized(logicalExpr)))
48464ab3302SCarolineConcatto 
48564ab3302SCarolineConcatto // R1044 where-body-construct ->
48664ab3302SCarolineConcatto //         where-assignment-stmt | where-stmt | where-construct
48764ab3302SCarolineConcatto TYPE_PARSER(construct<WhereBodyConstruct>(statement(assignmentStmt)) ||
48864ab3302SCarolineConcatto     construct<WhereBodyConstruct>(statement(whereStmt)) ||
48964ab3302SCarolineConcatto     construct<WhereBodyConstruct>(indirect(whereConstruct)))
49064ab3302SCarolineConcatto 
49164ab3302SCarolineConcatto // R1047 masked-elsewhere-stmt ->
49264ab3302SCarolineConcatto //         ELSEWHERE ( mask-expr ) [where-construct-name]
49364ab3302SCarolineConcatto TYPE_CONTEXT_PARSER("masked ELSEWHERE statement"_en_US,
49464ab3302SCarolineConcatto     construct<MaskedElsewhereStmt>(
49564ab3302SCarolineConcatto         "ELSE WHERE" >> parenthesized(logicalExpr), maybe(name)))
49664ab3302SCarolineConcatto 
49764ab3302SCarolineConcatto // R1048 elsewhere-stmt -> ELSEWHERE [where-construct-name]
49864ab3302SCarolineConcatto TYPE_CONTEXT_PARSER("ELSEWHERE statement"_en_US,
49964ab3302SCarolineConcatto     construct<ElsewhereStmt>("ELSE WHERE" >> maybe(name)))
50064ab3302SCarolineConcatto 
50164ab3302SCarolineConcatto // R1049 end-where-stmt -> ENDWHERE [where-construct-name]
50264ab3302SCarolineConcatto TYPE_CONTEXT_PARSER("END WHERE statement"_en_US,
503619b5bfcSPeter Klausler     construct<EndWhereStmt>(recovery(
504619b5bfcSPeter Klausler         "END WHERE" >> maybe(name), namedConstructEndStmtErrorRecovery)))
50564ab3302SCarolineConcatto 
50664ab3302SCarolineConcatto // R1050 forall-construct ->
50764ab3302SCarolineConcatto //         forall-construct-stmt [forall-body-construct]... end-forall-stmt
50864ab3302SCarolineConcatto TYPE_CONTEXT_PARSER("FORALL construct"_en_US,
50964ab3302SCarolineConcatto     construct<ForallConstruct>(statement(Parser<ForallConstructStmt>{}),
51064ab3302SCarolineConcatto         many(Parser<ForallBodyConstruct>{}),
51164ab3302SCarolineConcatto         statement(Parser<EndForallStmt>{})))
51264ab3302SCarolineConcatto 
51364ab3302SCarolineConcatto // R1051 forall-construct-stmt ->
51464ab3302SCarolineConcatto //         [forall-construct-name :] FORALL concurrent-header
51564ab3302SCarolineConcatto TYPE_CONTEXT_PARSER("FORALL construct statement"_en_US,
51664ab3302SCarolineConcatto     construct<ForallConstructStmt>(
51764ab3302SCarolineConcatto         maybe(name / ":"), "FORALL" >> indirect(concurrentHeader)))
51864ab3302SCarolineConcatto 
51964ab3302SCarolineConcatto // R1052 forall-body-construct ->
52064ab3302SCarolineConcatto //         forall-assignment-stmt | where-stmt | where-construct |
52164ab3302SCarolineConcatto //         forall-construct | forall-stmt
52264ab3302SCarolineConcatto TYPE_PARSER(construct<ForallBodyConstruct>(statement(forallAssignmentStmt)) ||
52364ab3302SCarolineConcatto     construct<ForallBodyConstruct>(statement(whereStmt)) ||
52464ab3302SCarolineConcatto     construct<ForallBodyConstruct>(whereConstruct) ||
52564ab3302SCarolineConcatto     construct<ForallBodyConstruct>(indirect(forallConstruct)) ||
52664ab3302SCarolineConcatto     construct<ForallBodyConstruct>(statement(forallStmt)))
52764ab3302SCarolineConcatto 
52864ab3302SCarolineConcatto // R1053 forall-assignment-stmt -> assignment-stmt | pointer-assignment-stmt
52964ab3302SCarolineConcatto TYPE_PARSER(construct<ForallAssignmentStmt>(assignmentStmt) ||
53064ab3302SCarolineConcatto     construct<ForallAssignmentStmt>(pointerAssignmentStmt))
53164ab3302SCarolineConcatto 
53264ab3302SCarolineConcatto // R1054 end-forall-stmt -> END FORALL [forall-construct-name]
53364ab3302SCarolineConcatto TYPE_CONTEXT_PARSER("END FORALL statement"_en_US,
534619b5bfcSPeter Klausler     construct<EndForallStmt>(recovery(
535619b5bfcSPeter Klausler         "END FORALL" >> maybe(name), namedConstructEndStmtErrorRecovery)))
53664ab3302SCarolineConcatto 
53764ab3302SCarolineConcatto // R1055 forall-stmt -> FORALL concurrent-header forall-assignment-stmt
53864ab3302SCarolineConcatto TYPE_CONTEXT_PARSER("FORALL statement"_en_US,
53964ab3302SCarolineConcatto     construct<ForallStmt>("FORALL" >> indirect(concurrentHeader),
54064ab3302SCarolineConcatto         unlabeledStatement(forallAssignmentStmt)))
5411f879005STim Keith } // namespace Fortran::parser
542