| 1 | //===-- lib/Parser/expr-parsers.cpp ---------------------------------------===// |
| 2 | // |
| 3 | // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
| 4 | // See https://llvm.org/LICENSE.txt for license information. |
| 5 | // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
| 6 | // |
| 7 | //===----------------------------------------------------------------------===// |
| 8 | |
| 9 | // Per-type parsers for expressions. |
| 10 | |
| 11 | #include "expr-parsers.h" |
| 12 | #include "basic-parsers.h" |
| 13 | #include "misc-parsers.h" |
| 14 | #include "stmt-parser.h" |
| 15 | #include "token-parsers.h" |
| 16 | #include "type-parser-implementation.h" |
| 17 | #include "flang/Parser/characters.h" |
| 18 | #include "flang/Parser/parse-tree.h" |
| 19 | |
| 20 | namespace Fortran::parser { |
| 21 | |
| 22 | // R764 boz-literal-constant -> binary-constant | octal-constant | hex-constant |
| 23 | // R765 binary-constant -> B ' digit [digit]... ' | B " digit [digit]... " |
| 24 | // R766 octal-constant -> O ' digit [digit]... ' | O " digit [digit]... " |
| 25 | // R767 hex-constant -> |
| 26 | // Z ' hex-digit [hex-digit]... ' | Z " hex-digit [hex-digit]... " |
| 27 | // extension: X accepted for Z |
| 28 | // extension: BOZX suffix accepted |
| 29 | TYPE_PARSER(construct<BOZLiteralConstant>(BOZLiteral{})) |
| 30 | |
| 31 | // R769 array-constructor -> (/ ac-spec /) | lbracket ac-spec rbracket |
| 32 | TYPE_CONTEXT_PARSER("array constructor"_en_US , |
| 33 | construct<ArrayConstructor>( |
| 34 | "(/" >> Parser<AcSpec>{} / "/)" || bracketed(Parser<AcSpec>{}))) |
| 35 | |
| 36 | // R770 ac-spec -> type-spec :: | [type-spec ::] ac-value-list |
| 37 | TYPE_PARSER(construct<AcSpec>(maybe(typeSpec / "::" ), |
| 38 | nonemptyList("expected array constructor values"_err_en_US , |
| 39 | Parser<AcValue>{})) || |
| 40 | construct<AcSpec>(typeSpec / "::" )) |
| 41 | |
| 42 | // R773 ac-value -> expr | ac-implied-do |
| 43 | TYPE_PARSER( |
| 44 | // PGI/Intel extension: accept triplets in array constructors |
| 45 | extension<LanguageFeature::TripletInArrayConstructor>( |
| 46 | "nonstandard usage: triplet in array constructor"_port_en_US , |
| 47 | construct<AcValue>(construct<AcValue::Triplet>(scalarIntExpr, |
| 48 | ":" >> scalarIntExpr, maybe(":" >> scalarIntExpr)))) || |
| 49 | construct<AcValue>(indirect(expr)) || |
| 50 | construct<AcValue>(indirect(Parser<AcImpliedDo>{}))) |
| 51 | |
| 52 | // R774 ac-implied-do -> ( ac-value-list , ac-implied-do-control ) |
| 53 | TYPE_PARSER(parenthesized( |
| 54 | construct<AcImpliedDo>(nonemptyList(Parser<AcValue>{} / lookAhead(","_tok )), |
| 55 | "," >> Parser<AcImpliedDoControl>{}))) |
| 56 | |
| 57 | // R775 ac-implied-do-control -> |
| 58 | // [integer-type-spec ::] ac-do-variable = scalar-int-expr , |
| 59 | // scalar-int-expr [, scalar-int-expr] |
| 60 | // R776 ac-do-variable -> do-variable |
| 61 | TYPE_PARSER(construct<AcImpliedDoControl>( |
| 62 | maybe(integerTypeSpec / "::" ), loopBounds(scalarIntExpr))) |
| 63 | |
| 64 | // R1001 primary -> |
| 65 | // literal-constant | designator | array-constructor | |
| 66 | // structure-constructor | function-reference | type-param-inquiry | |
| 67 | // type-param-name | ( expr ) |
| 68 | // type-param-inquiry is parsed as a structure component, except for |
| 69 | // substring%KIND/LEN |
| 70 | constexpr auto primary{instrumented("primary"_en_US , |
| 71 | first(construct<Expr>(indirect(charLiteralConstantSubstring)), |
| 72 | construct<Expr>(literalConstant), |
| 73 | construct<Expr>(construct<Expr::Parentheses>("(" >> |
| 74 | expr / !","_tok / recovery(")"_tok , SkipPastNested<'(', ')'>{}))), |
| 75 | construct<Expr>(indirect(functionReference) / !"("_tok / !"%"_tok ), |
| 76 | construct<Expr>(designator / !"("_tok / !"%"_tok ), |
| 77 | construct<Expr>(indirect(Parser<SubstringInquiry>{})), // %LEN or %KIND |
| 78 | construct<Expr>(Parser<StructureConstructor>{}), |
| 79 | construct<Expr>(Parser<ArrayConstructor>{}), |
| 80 | // PGI/XLF extension: COMPLEX constructor (x,y) |
| 81 | construct<Expr>(parenthesized( |
| 82 | construct<Expr::ComplexConstructor>(expr, "," >> expr))), |
| 83 | extension<LanguageFeature::PercentLOC>( |
| 84 | "nonstandard usage: %LOC"_port_en_US , |
| 85 | construct<Expr>("%LOC" >> parenthesized(construct<Expr::PercentLoc>( |
| 86 | indirect(variable)))))))}; |
| 87 | |
| 88 | // R1002 level-1-expr -> [defined-unary-op] primary |
| 89 | // TODO: Reasonable extension: permit multiple defined-unary-ops |
| 90 | constexpr auto level1Expr{sourced( |
| 91 | primary || // must come before define op to resolve .TRUE._8 ambiguity |
| 92 | construct<Expr>(construct<Expr::DefinedUnary>(definedOpName, primary)))}; |
| 93 | |
| 94 | // R1004 mult-operand -> level-1-expr [power-op mult-operand] |
| 95 | // R1007 power-op -> ** |
| 96 | // Exponentiation (**) is Fortran's only right-associative binary operation. |
| 97 | struct MultOperand { |
| 98 | using resultType = Expr; |
| 99 | constexpr MultOperand() {} |
| 100 | static inline std::optional<Expr> Parse(ParseState &); |
| 101 | }; |
| 102 | |
| 103 | // Extension: allow + or - before a mult-operand |
| 104 | // Such a unary operand has lower precedence than exponentiation, |
| 105 | // so -x**2 is -(x**2), not (-x)**2; this matches all other |
| 106 | // compilers with this extension. |
| 107 | static constexpr auto standardMultOperand{sourced(MultOperand{})}; |
| 108 | static constexpr auto multOperand{standardMultOperand || |
| 109 | extension<LanguageFeature::SignedMultOperand>( |
| 110 | "nonstandard usage: signed mult-operand"_port_en_US , |
| 111 | construct<Expr>( |
| 112 | construct<Expr::UnaryPlus>("+" >> standardMultOperand))) || |
| 113 | extension<LanguageFeature::SignedMultOperand>( |
| 114 | "nonstandard usage: signed mult-operand"_port_en_US , |
| 115 | construct<Expr>(construct<Expr::Negate>("-" >> standardMultOperand)))}; |
| 116 | |
| 117 | inline std::optional<Expr> MultOperand::Parse(ParseState &state) { |
| 118 | std::optional<Expr> result{level1Expr.Parse(state)}; |
| 119 | if (result) { |
| 120 | static constexpr auto op{attempt("**"_tok )}; |
| 121 | if (op.Parse(state)) { |
| 122 | std::function<Expr(Expr &&)> power{[&result](Expr &&right) { |
| 123 | return Expr{Expr::Power(std::move(result).value(), std::move(right))}; |
| 124 | }}; |
| 125 | return applyLambda(power, multOperand).Parse(state); // right-recursive |
| 126 | } |
| 127 | } |
| 128 | return result; |
| 129 | } |
| 130 | |
| 131 | // R1005 add-operand -> [add-operand mult-op] mult-operand |
| 132 | // R1008 mult-op -> * | / |
| 133 | // The left recursion in the grammar is implemented iteratively. |
| 134 | struct AddOperand { |
| 135 | using resultType = Expr; |
| 136 | constexpr AddOperand() {} |
| 137 | static inline std::optional<Expr> Parse(ParseState &state) { |
| 138 | std::optional<Expr> result{multOperand.Parse(state)}; |
| 139 | if (result) { |
| 140 | auto source{result->source}; |
| 141 | std::function<Expr(Expr &&)> multiply{[&result](Expr &&right) { |
| 142 | return Expr{ |
| 143 | Expr::Multiply(std::move(result).value(), std::move(right))}; |
| 144 | }}; |
| 145 | std::function<Expr(Expr &&)> divide{[&result](Expr &&right) { |
| 146 | return Expr{Expr::Divide(std::move(result).value(), std::move(right))}; |
| 147 | }}; |
| 148 | auto more{attempt(sourced("*" >> applyLambda(multiply, multOperand) || |
| 149 | "/" >> applyLambda(divide, multOperand)))}; |
| 150 | while (std::optional<Expr> next{more.Parse(state)}) { |
| 151 | result = std::move(next); |
| 152 | result->source.ExtendToCover(source); |
| 153 | } |
| 154 | } |
| 155 | return result; |
| 156 | } |
| 157 | }; |
| 158 | constexpr AddOperand addOperand; |
| 159 | |
| 160 | // R1006 level-2-expr -> [[level-2-expr] add-op] add-operand |
| 161 | // R1009 add-op -> + | - |
| 162 | // These are left-recursive productions, implemented iteratively. |
| 163 | // Note that standard Fortran admits a unary + or - to appear only here, |
| 164 | // by means of a missing first operand; e.g., 2*-3 is valid in C but not |
| 165 | // standard Fortran. We accept unary + and - to appear before any primary |
| 166 | // as an extension. |
| 167 | struct Level2Expr { |
| 168 | using resultType = Expr; |
| 169 | constexpr Level2Expr() {} |
| 170 | static inline std::optional<Expr> Parse(ParseState &state) { |
| 171 | static constexpr auto unary{ |
| 172 | sourced( |
| 173 | construct<Expr>(construct<Expr::UnaryPlus>("+" >> addOperand)) || |
| 174 | construct<Expr>(construct<Expr::Negate>("-" >> addOperand))) || |
| 175 | addOperand}; |
| 176 | std::optional<Expr> result{unary.Parse(state)}; |
| 177 | if (result) { |
| 178 | auto source{result->source}; |
| 179 | std::function<Expr(Expr &&)> add{[&result](Expr &&right) { |
| 180 | return Expr{Expr::Add(std::move(result).value(), std::move(right))}; |
| 181 | }}; |
| 182 | std::function<Expr(Expr &&)> subtract{[&result](Expr &&right) { |
| 183 | return Expr{ |
| 184 | Expr::Subtract(std::move(result).value(), std::move(right))}; |
| 185 | }}; |
| 186 | auto more{attempt(sourced("+" >> applyLambda(add, addOperand) || |
| 187 | "-" >> applyLambda(subtract, addOperand)))}; |
| 188 | while (std::optional<Expr> next{more.Parse(state)}) { |
| 189 | result = std::move(next); |
| 190 | result->source.ExtendToCover(source); |
| 191 | } |
| 192 | } |
| 193 | return result; |
| 194 | } |
| 195 | }; |
| 196 | constexpr Level2Expr level2Expr; |
| 197 | |
| 198 | // R1010 level-3-expr -> [level-3-expr concat-op] level-2-expr |
| 199 | // R1011 concat-op -> // |
| 200 | // Concatenation (//) is left-associative for parsing performance, although |
| 201 | // one would never notice if it were right-associated. |
| 202 | struct Level3Expr { |
| 203 | using resultType = Expr; |
| 204 | constexpr Level3Expr() {} |
| 205 | static inline std::optional<Expr> Parse(ParseState &state) { |
| 206 | std::optional<Expr> result{level2Expr.Parse(state)}; |
| 207 | if (result) { |
| 208 | auto source{result->source}; |
| 209 | std::function<Expr(Expr &&)> concat{[&result](Expr &&right) { |
| 210 | return Expr{Expr::Concat(std::move(result).value(), std::move(right))}; |
| 211 | }}; |
| 212 | auto more{attempt(sourced("//" >> applyLambda(concat, level2Expr)))}; |
| 213 | while (std::optional<Expr> next{more.Parse(state)}) { |
| 214 | result = std::move(next); |
| 215 | result->source.ExtendToCover(source); |
| 216 | } |
| 217 | } |
| 218 | return result; |
| 219 | } |
| 220 | }; |
| 221 | constexpr Level3Expr level3Expr; |
| 222 | |
| 223 | // R1012 level-4-expr -> [level-3-expr rel-op] level-3-expr |
| 224 | // R1013 rel-op -> |
| 225 | // .EQ. | .NE. | .LT. | .LE. | .GT. | .GE. | |
| 226 | // == | /= | < | <= | > | >= @ | <> |
| 227 | // N.B. relations are not recursive (i.e., LOGICAL is not ordered) |
| 228 | struct Level4Expr { |
| 229 | using resultType = Expr; |
| 230 | constexpr Level4Expr() {} |
| 231 | static inline std::optional<Expr> Parse(ParseState &state) { |
| 232 | std::optional<Expr> result{level3Expr.Parse(state)}; |
| 233 | if (result) { |
| 234 | auto source{result->source}; |
| 235 | std::function<Expr(Expr &&)> lt{[&result](Expr &&right) { |
| 236 | return Expr{Expr::LT(std::move(result).value(), std::move(right))}; |
| 237 | }}; |
| 238 | std::function<Expr(Expr &&)> le{[&result](Expr &&right) { |
| 239 | return Expr{Expr::LE(std::move(result).value(), std::move(right))}; |
| 240 | }}; |
| 241 | std::function<Expr(Expr &&)> eq{[&result](Expr &&right) { |
| 242 | return Expr{Expr::EQ(std::move(result).value(), std::move(right))}; |
| 243 | }}; |
| 244 | std::function<Expr(Expr &&)> ne{[&result](Expr &&right) { |
| 245 | return Expr{Expr::NE(std::move(result).value(), std::move(right))}; |
| 246 | }}; |
| 247 | std::function<Expr(Expr &&)> ge{[&result](Expr &&right) { |
| 248 | return Expr{Expr::GE(std::move(result).value(), std::move(right))}; |
| 249 | }}; |
| 250 | std::function<Expr(Expr &&)> gt{[&result](Expr &&right) { |
| 251 | return Expr{Expr::GT(std::move(result).value(), std::move(right))}; |
| 252 | }}; |
| 253 | auto more{attempt( |
| 254 | sourced((".LT."_tok || "<"_tok ) >> applyLambda(lt, level3Expr) || |
| 255 | (".LE."_tok || "<="_tok ) >> applyLambda(le, level3Expr) || |
| 256 | (".EQ."_tok || "=="_tok ) >> applyLambda(eq, level3Expr) || |
| 257 | (".NE."_tok || "/="_tok || |
| 258 | extension<LanguageFeature::AlternativeNE>( |
| 259 | "nonstandard usage: <> for /= or .NE."_port_en_US , |
| 260 | "<>"_tok /* PGI/Cray extension; Cray also has .LG. */)) >> |
| 261 | applyLambda(ne, level3Expr) || |
| 262 | (".GE."_tok || ">="_tok ) >> applyLambda(ge, level3Expr) || |
| 263 | (".GT."_tok || ">"_tok ) >> applyLambda(gt, level3Expr)))}; |
| 264 | if (std::optional<Expr> next{more.Parse(state)}) { |
| 265 | next->source.ExtendToCover(source); |
| 266 | return next; |
| 267 | } |
| 268 | } |
| 269 | return result; |
| 270 | } |
| 271 | }; |
| 272 | constexpr Level4Expr level4Expr; |
| 273 | |
| 274 | // R1014 and-operand -> [not-op] level-4-expr |
| 275 | // R1018 not-op -> .NOT. |
| 276 | // N.B. Fortran's .NOT. binds less tightly than its comparison operators do. |
| 277 | // PGI/Intel extension: accept multiple .NOT. operators |
| 278 | struct AndOperand { |
| 279 | using resultType = Expr; |
| 280 | constexpr AndOperand() {} |
| 281 | static inline std::optional<Expr> Parse(ParseState &); |
| 282 | }; |
| 283 | constexpr AndOperand andOperand; |
| 284 | |
| 285 | // Match a logical operator or, optionally, its abbreviation. |
| 286 | inline constexpr auto logicalOp(const char *op, const char *abbrev) { |
| 287 | return TokenStringMatch{op} || |
| 288 | extension<LanguageFeature::LogicalAbbreviations>( |
| 289 | "nonstandard usage: abbreviated LOGICAL operator"_port_en_US , |
| 290 | TokenStringMatch{abbrev}); |
| 291 | } |
| 292 | |
| 293 | inline std::optional<Expr> AndOperand::Parse(ParseState &state) { |
| 294 | static constexpr auto notOp{attempt(logicalOp(op: ".NOT." , abbrev: ".N." ) >> andOperand)}; |
| 295 | if (std::optional<Expr> negation{notOp.Parse(state)}) { |
| 296 | return Expr{Expr::NOT{std::move(*negation)}}; |
| 297 | } else { |
| 298 | return level4Expr.Parse(state); |
| 299 | } |
| 300 | } |
| 301 | |
| 302 | // R1015 or-operand -> [or-operand and-op] and-operand |
| 303 | // R1019 and-op -> .AND. |
| 304 | // .AND. is left-associative |
| 305 | struct OrOperand { |
| 306 | using resultType = Expr; |
| 307 | constexpr OrOperand() {} |
| 308 | static inline std::optional<Expr> Parse(ParseState &state) { |
| 309 | static constexpr auto operand{sourced(andOperand)}; |
| 310 | std::optional<Expr> result{operand.Parse(state)}; |
| 311 | if (result) { |
| 312 | auto source{result->source}; |
| 313 | std::function<Expr(Expr &&)> logicalAnd{[&result](Expr &&right) { |
| 314 | return Expr{Expr::AND(std::move(result).value(), std::move(right))}; |
| 315 | }}; |
| 316 | auto more{attempt(sourced( |
| 317 | logicalOp(op: ".AND." , abbrev: ".A." ) >> applyLambda(logicalAnd, andOperand)))}; |
| 318 | while (std::optional<Expr> next{more.Parse(state)}) { |
| 319 | result = std::move(next); |
| 320 | result->source.ExtendToCover(source); |
| 321 | } |
| 322 | } |
| 323 | return result; |
| 324 | } |
| 325 | }; |
| 326 | constexpr OrOperand orOperand; |
| 327 | |
| 328 | // R1016 equiv-operand -> [equiv-operand or-op] or-operand |
| 329 | // R1020 or-op -> .OR. |
| 330 | // .OR. is left-associative |
| 331 | struct EquivOperand { |
| 332 | using resultType = Expr; |
| 333 | constexpr EquivOperand() {} |
| 334 | static inline std::optional<Expr> Parse(ParseState &state) { |
| 335 | std::optional<Expr> result{orOperand.Parse(state)}; |
| 336 | if (result) { |
| 337 | auto source{result->source}; |
| 338 | std::function<Expr(Expr &&)> logicalOr{[&result](Expr &&right) { |
| 339 | return Expr{Expr::OR(std::move(result).value(), std::move(right))}; |
| 340 | }}; |
| 341 | auto more{attempt(sourced( |
| 342 | logicalOp(op: ".OR." , abbrev: ".O." ) >> applyLambda(logicalOr, orOperand)))}; |
| 343 | while (std::optional<Expr> next{more.Parse(state)}) { |
| 344 | result = std::move(next); |
| 345 | result->source.ExtendToCover(source); |
| 346 | } |
| 347 | } |
| 348 | return result; |
| 349 | } |
| 350 | }; |
| 351 | constexpr EquivOperand equivOperand; |
| 352 | |
| 353 | // R1017 level-5-expr -> [level-5-expr equiv-op] equiv-operand |
| 354 | // R1021 equiv-op -> .EQV. | .NEQV. |
| 355 | // Logical equivalence is left-associative. |
| 356 | // Extension: .XOR. as synonym for .NEQV. |
| 357 | struct Level5Expr { |
| 358 | using resultType = Expr; |
| 359 | constexpr Level5Expr() {} |
| 360 | static inline std::optional<Expr> Parse(ParseState &state) { |
| 361 | std::optional<Expr> result{equivOperand.Parse(state)}; |
| 362 | if (result) { |
| 363 | auto source{result->source}; |
| 364 | std::function<Expr(Expr &&)> eqv{[&result](Expr &&right) { |
| 365 | return Expr{Expr::EQV(std::move(result).value(), std::move(right))}; |
| 366 | }}; |
| 367 | std::function<Expr(Expr &&)> neqv{[&result](Expr &&right) { |
| 368 | return Expr{Expr::NEQV(std::move(result).value(), std::move(right))}; |
| 369 | }}; |
| 370 | auto more{attempt(sourced(".EQV." >> applyLambda(eqv, equivOperand) || |
| 371 | (".NEQV."_tok || |
| 372 | extension<LanguageFeature::XOROperator>( |
| 373 | "nonstandard usage: .XOR./.X. spelling of .NEQV."_port_en_US , |
| 374 | logicalOp(".XOR." , ".X." ))) >> |
| 375 | applyLambda(neqv, equivOperand)))}; |
| 376 | while (std::optional<Expr> next{more.Parse(state)}) { |
| 377 | result = std::move(next); |
| 378 | result->source.ExtendToCover(source); |
| 379 | } |
| 380 | } |
| 381 | return result; |
| 382 | } |
| 383 | }; |
| 384 | constexpr Level5Expr level5Expr; |
| 385 | |
| 386 | // R1022 expr -> [expr defined-binary-op] level-5-expr |
| 387 | // Defined binary operators associate leftwards. |
| 388 | template <> std::optional<Expr> Parser<Expr>::Parse(ParseState &state) { |
| 389 | std::optional<Expr> result{level5Expr.Parse(state)}; |
| 390 | if (result) { |
| 391 | auto source{result->source}; |
| 392 | std::function<Expr(DefinedOpName &&, Expr &&)> defBinOp{ |
| 393 | [&result](DefinedOpName &&op, Expr &&right) { |
| 394 | return Expr{Expr::DefinedBinary( |
| 395 | std::move(op), std::move(result).value(), std::move(right))}; |
| 396 | }}; |
| 397 | auto more{attempt( |
| 398 | sourced(applyLambda<Expr>(defBinOp, definedOpName, level5Expr)))}; |
| 399 | while (std::optional<Expr> next{more.Parse(state)}) { |
| 400 | result = std::move(next); |
| 401 | result->source.ExtendToCover(source); |
| 402 | } |
| 403 | } |
| 404 | return result; |
| 405 | } |
| 406 | |
| 407 | // R1003 defined-unary-op -> . letter [letter]... . |
| 408 | // R1023 defined-binary-op -> . letter [letter]... . |
| 409 | // R1414 local-defined-operator -> defined-unary-op | defined-binary-op |
| 410 | // R1415 use-defined-operator -> defined-unary-op | defined-binary-op |
| 411 | // C1003 A defined operator must be distinct from logical literal constants |
| 412 | // and intrinsic operator names; this is handled by attempting their parses |
| 413 | // first, and by name resolution on their definitions, for best errors. |
| 414 | // N.B. The name of the operator is captured with the dots around it. |
| 415 | constexpr auto definedOpNameChar{letter || |
| 416 | extension<LanguageFeature::PunctuationInNames>( |
| 417 | "nonstandard usage: non-alphabetic character in defined operator"_port_en_US , |
| 418 | "$@"_ch )}; |
| 419 | TYPE_PARSER( |
| 420 | space >> construct<DefinedOpName>(sourced("."_ch >> |
| 421 | some(definedOpNameChar) >> construct<Name>() / "."_ch ))) |
| 422 | |
| 423 | // R1028 specification-expr -> scalar-int-expr |
| 424 | TYPE_PARSER(construct<SpecificationExpr>(scalarIntExpr)) |
| 425 | |
| 426 | // R1032 assignment-stmt -> variable = expr |
| 427 | TYPE_CONTEXT_PARSER("assignment statement"_en_US , |
| 428 | construct<AssignmentStmt>(variable / "=" , expr)) |
| 429 | |
| 430 | // R1033 pointer-assignment-stmt -> |
| 431 | // data-pointer-object [( bounds-spec-list )] => data-target | |
| 432 | // data-pointer-object ( bounds-remapping-list ) => data-target | |
| 433 | // proc-pointer-object => proc-target |
| 434 | // R1034 data-pointer-object -> |
| 435 | // variable-name | scalar-variable % data-pointer-component-name |
| 436 | // C1022 a scalar-variable shall be a data-ref |
| 437 | // C1024 a data-pointer-object shall not be a coindexed object |
| 438 | // R1038 proc-pointer-object -> proc-pointer-name | proc-component-ref |
| 439 | // |
| 440 | // A distinction can't be made at the time of the initial parse between |
| 441 | // data-pointer-object and proc-pointer-object, or between data-target |
| 442 | // and proc-target. |
| 443 | TYPE_CONTEXT_PARSER("pointer assignment statement"_en_US , |
| 444 | construct<PointerAssignmentStmt>(dataRef, |
| 445 | parenthesized(nonemptyList(Parser<BoundsRemapping>{})), "=>" >> expr) || |
| 446 | construct<PointerAssignmentStmt>(dataRef, |
| 447 | defaulted(parenthesized(nonemptyList(Parser<BoundsSpec>{}))), |
| 448 | "=>" >> expr)) |
| 449 | |
| 450 | // R1035 bounds-spec -> lower-bound-expr : |
| 451 | TYPE_PARSER(construct<BoundsSpec>(boundExpr / ":" )) |
| 452 | |
| 453 | // R1036 bounds-remapping -> lower-bound-expr : upper-bound-expr |
| 454 | TYPE_PARSER(construct<BoundsRemapping>(boundExpr / ":" , boundExpr)) |
| 455 | |
| 456 | // R1039 proc-component-ref -> scalar-variable % procedure-component-name |
| 457 | // C1027 the scalar-variable must be a data-ref without coindices. |
| 458 | TYPE_PARSER(construct<ProcComponentRef>(structureComponent)) |
| 459 | |
| 460 | // R1041 where-stmt -> WHERE ( mask-expr ) where-assignment-stmt |
| 461 | // R1045 where-assignment-stmt -> assignment-stmt |
| 462 | // R1046 mask-expr -> logical-expr |
| 463 | TYPE_CONTEXT_PARSER("WHERE statement"_en_US , |
| 464 | construct<WhereStmt>("WHERE" >> parenthesized(logicalExpr), assignmentStmt)) |
| 465 | |
| 466 | // R1042 where-construct -> |
| 467 | // where-construct-stmt [where-body-construct]... |
| 468 | // [masked-elsewhere-stmt [where-body-construct]...]... |
| 469 | // [elsewhere-stmt [where-body-construct]...] end-where-stmt |
| 470 | TYPE_CONTEXT_PARSER("WHERE construct"_en_US , |
| 471 | construct<WhereConstruct>(statement(Parser<WhereConstructStmt>{}), |
| 472 | many(whereBodyConstruct), |
| 473 | many(construct<WhereConstruct::MaskedElsewhere>( |
| 474 | statement(Parser<MaskedElsewhereStmt>{}), |
| 475 | many(whereBodyConstruct))), |
| 476 | maybe(construct<WhereConstruct::Elsewhere>( |
| 477 | statement(Parser<ElsewhereStmt>{}), many(whereBodyConstruct))), |
| 478 | statement(Parser<EndWhereStmt>{}))) |
| 479 | |
| 480 | // R1043 where-construct-stmt -> [where-construct-name :] WHERE ( mask-expr ) |
| 481 | TYPE_CONTEXT_PARSER("WHERE construct statement"_en_US , |
| 482 | construct<WhereConstructStmt>( |
| 483 | maybe(name / ":" ), "WHERE" >> parenthesized(logicalExpr))) |
| 484 | |
| 485 | // R1044 where-body-construct -> |
| 486 | // where-assignment-stmt | where-stmt | where-construct |
| 487 | TYPE_PARSER(construct<WhereBodyConstruct>(statement(assignmentStmt)) || |
| 488 | construct<WhereBodyConstruct>(statement(whereStmt)) || |
| 489 | construct<WhereBodyConstruct>(indirect(whereConstruct))) |
| 490 | |
| 491 | // R1047 masked-elsewhere-stmt -> |
| 492 | // ELSEWHERE ( mask-expr ) [where-construct-name] |
| 493 | TYPE_CONTEXT_PARSER("masked ELSEWHERE statement"_en_US , |
| 494 | construct<MaskedElsewhereStmt>( |
| 495 | "ELSE WHERE" >> parenthesized(logicalExpr), maybe(name))) |
| 496 | |
| 497 | // R1048 elsewhere-stmt -> ELSEWHERE [where-construct-name] |
| 498 | TYPE_CONTEXT_PARSER("ELSEWHERE statement"_en_US , |
| 499 | construct<ElsewhereStmt>("ELSE WHERE" >> maybe(name))) |
| 500 | |
| 501 | // R1049 end-where-stmt -> ENDWHERE [where-construct-name] |
| 502 | TYPE_CONTEXT_PARSER("END WHERE statement"_en_US , |
| 503 | construct<EndWhereStmt>(recovery( |
| 504 | "END WHERE" >> maybe(name), namedConstructEndStmtErrorRecovery))) |
| 505 | |
| 506 | // R1050 forall-construct -> |
| 507 | // forall-construct-stmt [forall-body-construct]... end-forall-stmt |
| 508 | TYPE_CONTEXT_PARSER("FORALL construct"_en_US , |
| 509 | construct<ForallConstruct>(statement(Parser<ForallConstructStmt>{}), |
| 510 | many(Parser<ForallBodyConstruct>{}), |
| 511 | statement(Parser<EndForallStmt>{}))) |
| 512 | |
| 513 | // R1051 forall-construct-stmt -> |
| 514 | // [forall-construct-name :] FORALL concurrent-header |
| 515 | TYPE_CONTEXT_PARSER("FORALL construct statement"_en_US , |
| 516 | construct<ForallConstructStmt>( |
| 517 | maybe(name / ":" ), "FORALL" >> indirect(concurrentHeader))) |
| 518 | |
| 519 | // R1052 forall-body-construct -> |
| 520 | // forall-assignment-stmt | where-stmt | where-construct | |
| 521 | // forall-construct | forall-stmt |
| 522 | TYPE_PARSER(construct<ForallBodyConstruct>(statement(forallAssignmentStmt)) || |
| 523 | construct<ForallBodyConstruct>(statement(whereStmt)) || |
| 524 | construct<ForallBodyConstruct>(whereConstruct) || |
| 525 | construct<ForallBodyConstruct>(indirect(forallConstruct)) || |
| 526 | construct<ForallBodyConstruct>(statement(forallStmt))) |
| 527 | |
| 528 | // R1053 forall-assignment-stmt -> assignment-stmt | pointer-assignment-stmt |
| 529 | TYPE_PARSER(construct<ForallAssignmentStmt>(assignmentStmt) || |
| 530 | construct<ForallAssignmentStmt>(pointerAssignmentStmt)) |
| 531 | |
| 532 | // R1054 end-forall-stmt -> END FORALL [forall-construct-name] |
| 533 | TYPE_CONTEXT_PARSER("END FORALL statement"_en_US , |
| 534 | construct<EndForallStmt>(recovery( |
| 535 | "END FORALL" >> maybe(name), namedConstructEndStmtErrorRecovery))) |
| 536 | |
| 537 | // R1055 forall-stmt -> FORALL concurrent-header forall-assignment-stmt |
| 538 | TYPE_CONTEXT_PARSER("FORALL statement"_en_US , |
| 539 | construct<ForallStmt>("FORALL" >> indirect(concurrentHeader), |
| 540 | unlabeledStatement(forallAssignmentStmt))) |
| 541 | } // namespace Fortran::parser |
| 542 | |