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