698 lines · cpp
1//===-- lib/Parser/io-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-exception6//7//===----------------------------------------------------------------------===//8 9// Per-type parsers for I/O statements and FORMAT10 11#include "basic-parsers.h"12#include "expr-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 20namespace Fortran::parser {21// R1201 io-unit -> file-unit-number | * | internal-file-variable22// R1203 internal-file-variable -> char-variable23// R905 char-variable -> variable24// "char-variable" is attempted first since it's not type constrained but25// syntactically ambiguous with "file-unit-number", which is constrained.26// Note, "file-unit-number" is replaced by "expr" to allow for better27// error messages.28TYPE_PARSER(construct<IoUnit>(variable / lookAhead(space / ",);\n"_ch)) ||29 construct<IoUnit>(30 indirect(expr) / (lookAhead(space >> ",)"_ch) || atEndOfStmt)) ||31 construct<IoUnit>(star))32 33// R1202 file-unit-number -> scalar-int-expr34TYPE_PARSER(construct<FileUnitNumber>(35 scalarIntExpr / (lookAhead(space >> ",)"_ch) || atEndOfStmt)))36 37// R1204 open-stmt -> OPEN ( connect-spec-list )38TYPE_CONTEXT_PARSER("OPEN statement"_en_US,39 construct<OpenStmt>(40 "OPEN (" >> nonemptyList("expected connection specifications"_err_en_US,41 Parser<ConnectSpec>{}) /42 ")"))43 44// R1206 file-name-expr -> scalar-default-char-expr45constexpr auto fileNameExpr{scalarDefaultCharExpr};46 47// R1205 connect-spec ->48// [UNIT =] file-unit-number | ACCESS = scalar-default-char-expr |49// ACTION = scalar-default-char-expr |50// ASYNCHRONOUS = scalar-default-char-expr |51// BLANK = scalar-default-char-expr |52// DECIMAL = scalar-default-char-expr |53// DELIM = scalar-default-char-expr |54// ENCODING = scalar-default-char-expr | ERR = label |55// FILE = file-name-expr | FORM = scalar-default-char-expr |56// IOMSG = iomsg-variable | IOSTAT = scalar-int-variable |57// NEWUNIT = scalar-int-variable | PAD = scalar-default-char-expr |58// POSITION = scalar-default-char-expr | RECL = scalar-int-expr |59// ROUND = scalar-default-char-expr | SIGN = scalar-default-char-expr |60// STATUS = scalar-default-char-expr61// @ | CARRIAGECONTROL = scalar-default-char-variable62// | CONVERT = scalar-default-char-variable63// | DISPOSE = scalar-default-char-variable64constexpr auto statusExpr{construct<StatusExpr>(scalarDefaultCharExpr)};65constexpr auto errLabel{construct<ErrLabel>(label)};66 67TYPE_PARSER(first(construct<ConnectSpec>(maybe("UNIT ="_tok) >> fileUnitNumber),68 construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(69 "ACCESS =" >> pure(ConnectSpec::CharExpr::Kind::Access),70 scalarDefaultCharExpr)),71 construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(72 "ACTION =" >> pure(ConnectSpec::CharExpr::Kind::Action),73 scalarDefaultCharExpr)),74 construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(75 "ASYNCHRONOUS =" >> pure(ConnectSpec::CharExpr::Kind::Asynchronous),76 scalarDefaultCharExpr)),77 construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(78 "BLANK =" >> pure(ConnectSpec::CharExpr::Kind::Blank),79 scalarDefaultCharExpr)),80 construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(81 "DECIMAL =" >> pure(ConnectSpec::CharExpr::Kind::Decimal),82 scalarDefaultCharExpr)),83 construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(84 "DELIM =" >> pure(ConnectSpec::CharExpr::Kind::Delim),85 scalarDefaultCharExpr)),86 construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(87 "ENCODING =" >> pure(ConnectSpec::CharExpr::Kind::Encoding),88 scalarDefaultCharExpr)),89 construct<ConnectSpec>("ERR =" >> errLabel),90 construct<ConnectSpec>("FILE =" >> fileNameExpr),91 extension<LanguageFeature::FileName>(92 "nonstandard usage: NAME= in place of FILE="_port_en_US,93 construct<ConnectSpec>("NAME =" >> fileNameExpr)),94 construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(95 "FORM =" >> pure(ConnectSpec::CharExpr::Kind::Form),96 scalarDefaultCharExpr)),97 construct<ConnectSpec>("IOMSG =" >> msgVariable),98 construct<ConnectSpec>("IOSTAT =" >> statVariable),99 construct<ConnectSpec>(construct<ConnectSpec::Newunit>(100 "NEWUNIT =" >> scalar(integer(variable)))),101 construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(102 "PAD =" >> pure(ConnectSpec::CharExpr::Kind::Pad),103 scalarDefaultCharExpr)),104 construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(105 "POSITION =" >> pure(ConnectSpec::CharExpr::Kind::Position),106 scalarDefaultCharExpr)),107 construct<ConnectSpec>(108 construct<ConnectSpec::Recl>("RECL =" >> scalarIntExpr)),109 construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(110 "ROUND =" >> pure(ConnectSpec::CharExpr::Kind::Round),111 scalarDefaultCharExpr)),112 construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(113 "SIGN =" >> pure(ConnectSpec::CharExpr::Kind::Sign),114 scalarDefaultCharExpr)),115 construct<ConnectSpec>("STATUS =" >> statusExpr),116 extension<LanguageFeature::Carriagecontrol>(117 "nonstandard usage: CARRIAGECONTROL="_port_en_US,118 construct<ConnectSpec>(119 construct<ConnectSpec::CharExpr>("CARRIAGECONTROL =" >>120 pure(ConnectSpec::CharExpr::Kind::Carriagecontrol),121 scalarDefaultCharExpr))),122 extension<LanguageFeature::Convert>(123 "nonstandard usage: CONVERT="_port_en_US,124 construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(125 "CONVERT =" >> pure(ConnectSpec::CharExpr::Kind::Convert),126 scalarDefaultCharExpr))),127 extension<LanguageFeature::Dispose>(128 "nonstandard usage: DISPOSE="_port_en_US,129 construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(130 "DISPOSE =" >> pure(ConnectSpec::CharExpr::Kind::Dispose),131 scalarDefaultCharExpr)))))132 133// R1209 close-spec ->134// [UNIT =] file-unit-number | IOSTAT = scalar-int-variable |135// IOMSG = iomsg-variable | ERR = label |136// STATUS = scalar-default-char-expr137constexpr auto closeSpec{first(138 construct<CloseStmt::CloseSpec>(maybe("UNIT ="_tok) >> fileUnitNumber),139 construct<CloseStmt::CloseSpec>("IOSTAT =" >> statVariable),140 construct<CloseStmt::CloseSpec>("IOMSG =" >> msgVariable),141 construct<CloseStmt::CloseSpec>("ERR =" >> errLabel),142 construct<CloseStmt::CloseSpec>("STATUS =" >> statusExpr))};143 144// R1208 close-stmt -> CLOSE ( close-spec-list )145TYPE_CONTEXT_PARSER("CLOSE statement"_en_US,146 construct<CloseStmt>("CLOSE" >> parenthesized(nonemptyList(closeSpec))))147 148// R1210 read-stmt ->149// READ ( io-control-spec-list ) [input-item-list] |150// READ format [, input-item-list]151// The ambiguous READ(CVAR) is parsed as if CVAR were the unit.152// As Fortran doesn't have internal unformatted I/O, it should153// be parsed as if (CVAR) were a format; this is corrected by154// rewriting in semantics when we know that CVAR is character.155constexpr auto inputItemList{156 extension<LanguageFeature::IOListLeadingComma>(157 "nonstandard usage: leading comma in input item list"_port_en_US,158 some("," >> inputItem)) || // legacy extension: leading comma159 optionalList(inputItem)};160 161TYPE_CONTEXT_PARSER("READ statement"_en_US,162 construct<ReadStmt>("READ (" >>163 construct<std::optional<IoUnit>>(maybe("UNIT ="_tok) >> ioUnit),164 "," >> construct<std::optional<Format>>(format),165 defaulted("," >> nonemptyList(ioControlSpec)) / ")", inputItemList) ||166 construct<ReadStmt>(167 "READ (" >> construct<std::optional<IoUnit>>(ioUnit),168 construct<std::optional<Format>>(),169 defaulted("," >> nonemptyList(ioControlSpec)) / ")",170 inputItemList) ||171 construct<ReadStmt>("READ" >> construct<std::optional<IoUnit>>(),172 construct<std::optional<Format>>(),173 parenthesized(nonemptyList(ioControlSpec)), inputItemList) ||174 construct<ReadStmt>("READ" >> construct<std::optional<IoUnit>>(),175 construct<std::optional<Format>>(format),176 construct<std::list<IoControlSpec>>(), many("," >> inputItem)))177 178// R1214 id-variable -> scalar-int-variable179constexpr auto idVariable{construct<IdVariable>(scalarIntVariable)};180 181// R1213 io-control-spec ->182// [UNIT =] io-unit | [FMT =] format | [NML =] namelist-group-name |183// ADVANCE = scalar-default-char-expr |184// ASYNCHRONOUS = scalar-default-char-constant-expr |185// BLANK = scalar-default-char-expr |186// DECIMAL = scalar-default-char-expr |187// DELIM = scalar-default-char-expr | END = label | EOR = label |188// ERR = label | ID = id-variable | IOMSG = iomsg-variable |189// IOSTAT = scalar-int-variable | PAD = scalar-default-char-expr |190// POS = scalar-int-expr | REC = scalar-int-expr |191// ROUND = scalar-default-char-expr | SIGN = scalar-default-char-expr |192// SIZE = scalar-int-variable193constexpr auto endLabel{construct<EndLabel>(label)};194constexpr auto eorLabel{construct<EorLabel>(label)};195TYPE_PARSER(first(construct<IoControlSpec>("UNIT =" >> ioUnit),196 construct<IoControlSpec>("FMT =" >> format),197 construct<IoControlSpec>("NML =" >> name),198 construct<IoControlSpec>(199 "ADVANCE =" >> construct<IoControlSpec::CharExpr>(200 pure(IoControlSpec::CharExpr::Kind::Advance),201 scalarDefaultCharExpr)),202 construct<IoControlSpec>(construct<IoControlSpec::Asynchronous>(203 "ASYNCHRONOUS =" >> scalarDefaultCharConstantExpr)),204 construct<IoControlSpec>("BLANK =" >>205 construct<IoControlSpec::CharExpr>(206 pure(IoControlSpec::CharExpr::Kind::Blank), scalarDefaultCharExpr)),207 construct<IoControlSpec>(208 "DECIMAL =" >> construct<IoControlSpec::CharExpr>(209 pure(IoControlSpec::CharExpr::Kind::Decimal),210 scalarDefaultCharExpr)),211 construct<IoControlSpec>("DELIM =" >>212 construct<IoControlSpec::CharExpr>(213 pure(IoControlSpec::CharExpr::Kind::Delim), scalarDefaultCharExpr)),214 construct<IoControlSpec>("END =" >> endLabel),215 construct<IoControlSpec>("EOR =" >> eorLabel),216 construct<IoControlSpec>("ERR =" >> errLabel),217 construct<IoControlSpec>("ID =" >> idVariable),218 construct<IoControlSpec>("IOMSG = " >> msgVariable),219 construct<IoControlSpec>("IOSTAT = " >> statVariable),220 construct<IoControlSpec>("PAD =" >>221 construct<IoControlSpec::CharExpr>(222 pure(IoControlSpec::CharExpr::Kind::Pad), scalarDefaultCharExpr)),223 construct<IoControlSpec>(224 "POS =" >> construct<IoControlSpec::Pos>(scalarIntExpr)),225 construct<IoControlSpec>(226 "REC =" >> construct<IoControlSpec::Rec>(scalarIntExpr)),227 construct<IoControlSpec>("ROUND =" >>228 construct<IoControlSpec::CharExpr>(229 pure(IoControlSpec::CharExpr::Kind::Round), scalarDefaultCharExpr)),230 construct<IoControlSpec>("SIGN =" >>231 construct<IoControlSpec::CharExpr>(232 pure(IoControlSpec::CharExpr::Kind::Sign), scalarDefaultCharExpr)),233 construct<IoControlSpec>(234 "SIZE =" >> construct<IoControlSpec::Size>(scalarIntVariable))))235 236// R1211 write-stmt -> WRITE ( io-control-spec-list ) [output-item-list]237constexpr auto outputItemList{238 extension<LanguageFeature::IOListLeadingComma>(239 "nonstandard usage: leading comma in output item list"_port_en_US,240 some("," >> outputItem)) || // legacy: allow leading comma241 optionalList(outputItem)};242 243TYPE_CONTEXT_PARSER("WRITE statement"_en_US,244 construct<WriteStmt>("WRITE (" >>245 construct<std::optional<IoUnit>>(maybe("UNIT ="_tok) >> ioUnit),246 "," >> construct<std::optional<Format>>(format),247 defaulted("," >> nonemptyList(ioControlSpec)) / ")", outputItemList) ||248 construct<WriteStmt>(249 "WRITE (" >> construct<std::optional<IoUnit>>(ioUnit),250 construct<std::optional<Format>>(),251 defaulted("," >> nonemptyList(ioControlSpec)) / ")",252 outputItemList) ||253 construct<WriteStmt>("WRITE" >> construct<std::optional<IoUnit>>(),254 construct<std::optional<Format>>(),255 parenthesized(nonemptyList(ioControlSpec)), outputItemList))256 257// R1212 print-stmt PRINT format [, output-item-list]258TYPE_CONTEXT_PARSER("PRINT statement"_en_US,259 construct<PrintStmt>(260 "PRINT" >> format, defaulted("," >> nonemptyList(outputItem))))261 262// R1215 format -> default-char-expr | label | *263// deprecated(ASSIGN): | scalar-int-name264TYPE_PARSER(construct<Format>(label / !"_."_ch) ||265 construct<Format>(expr / !"="_tok) || construct<Format>(star))266 267// R1216 input-item -> variable | io-implied-do268TYPE_PARSER(construct<InputItem>(variable) ||269 construct<InputItem>(indirect(inputImpliedDo)))270 271// R1217 output-item -> expr | io-implied-do272TYPE_PARSER(construct<OutputItem>(expr) ||273 construct<OutputItem>(indirect(outputImpliedDo)))274 275// R1220 io-implied-do-control ->276// do-variable = scalar-int-expr , scalar-int-expr [, scalar-int-expr]277constexpr auto ioImpliedDoControl{loopBounds(scalarIntExpr)};278 279// R1218 io-implied-do -> ( io-implied-do-object-list , io-implied-do-control )280// R1219 io-implied-do-object -> input-item | output-item281TYPE_CONTEXT_PARSER("input implied DO"_en_US,282 parenthesized(283 construct<InputImpliedDo>(nonemptyList(inputItem / lookAhead(","_tok)),284 "," >> ioImpliedDoControl)))285TYPE_CONTEXT_PARSER("output implied DO"_en_US,286 parenthesized(construct<OutputImpliedDo>(287 nonemptyList(outputItem / lookAhead(","_tok)),288 "," >> ioImpliedDoControl)))289 290// R1222 wait-stmt -> WAIT ( wait-spec-list )291TYPE_CONTEXT_PARSER("WAIT statement"_en_US,292 "WAIT" >>293 parenthesized(construct<WaitStmt>(nonemptyList(Parser<WaitSpec>{}))))294 295// R1223 wait-spec ->296// [UNIT =] file-unit-number | END = label | EOR = label | ERR = label |297// ID = scalar-int-expr | IOMSG = iomsg-variable |298// IOSTAT = scalar-int-variable299constexpr auto idExpr{construct<IdExpr>(scalarIntExpr)};300 301TYPE_PARSER(first(construct<WaitSpec>(maybe("UNIT ="_tok) >> fileUnitNumber),302 construct<WaitSpec>("END =" >> endLabel),303 construct<WaitSpec>("EOR =" >> eorLabel),304 construct<WaitSpec>("ERR =" >> errLabel),305 construct<WaitSpec>("ID =" >> idExpr),306 construct<WaitSpec>("IOMSG =" >> msgVariable),307 construct<WaitSpec>("IOSTAT =" >> statVariable)))308 309constexpr auto bareUnitNumberAsList{310 applyFunction(singletonList<PositionOrFlushSpec>,311 construct<PositionOrFlushSpec>(fileUnitNumber))};312constexpr auto positionOrFlushSpecList{313 parenthesized(nonemptyList(positionOrFlushSpec)) || bareUnitNumberAsList};314 315// R1224 backspace-stmt ->316// BACKSPACE file-unit-number | BACKSPACE ( position-spec-list )317TYPE_CONTEXT_PARSER("BACKSPACE statement"_en_US,318 construct<BackspaceStmt>("BACKSPACE" >> positionOrFlushSpecList))319 320// R1225 endfile-stmt ->321// ENDFILE file-unit-number | ENDFILE ( position-spec-list )322TYPE_CONTEXT_PARSER("ENDFILE statement"_en_US,323 construct<EndfileStmt>("END FILE" >> positionOrFlushSpecList))324 325// R1226 rewind-stmt -> REWIND file-unit-number | REWIND ( position-spec-list )326TYPE_CONTEXT_PARSER("REWIND statement"_en_US,327 construct<RewindStmt>("REWIND" >> positionOrFlushSpecList))328 329// R1227 position-spec ->330// [UNIT =] file-unit-number | IOMSG = iomsg-variable |331// IOSTAT = scalar-int-variable | ERR = label332// R1229 flush-spec ->333// [UNIT =] file-unit-number | IOSTAT = scalar-int-variable |334// IOMSG = iomsg-variable | ERR = label335TYPE_PARSER(336 construct<PositionOrFlushSpec>(maybe("UNIT ="_tok) >> fileUnitNumber) ||337 construct<PositionOrFlushSpec>("IOMSG =" >> msgVariable) ||338 construct<PositionOrFlushSpec>("IOSTAT =" >> statVariable) ||339 construct<PositionOrFlushSpec>("ERR =" >> errLabel))340 341// R1228 flush-stmt -> FLUSH file-unit-number | FLUSH ( flush-spec-list )342TYPE_CONTEXT_PARSER("FLUSH statement"_en_US,343 construct<FlushStmt>("FLUSH" >> positionOrFlushSpecList))344 345// R1231 inquire-spec ->346// [UNIT =] file-unit-number | FILE = file-name-expr |347// ACCESS = scalar-default-char-variable |348// ACTION = scalar-default-char-variable |349// ASYNCHRONOUS = scalar-default-char-variable |350// BLANK = scalar-default-char-variable |351// DECIMAL = scalar-default-char-variable |352// DELIM = scalar-default-char-variable |353// ENCODING = scalar-default-char-variable |354// ERR = label | EXIST = scalar-logical-variable |355// FORM = scalar-default-char-variable |356// FORMATTED = scalar-default-char-variable |357// ID = scalar-int-expr | IOMSG = iomsg-variable |358// IOSTAT = scalar-int-variable |359// NAME = scalar-default-char-variable |360// NAMED = scalar-logical-variable |361// NEXTREC = scalar-int-variable | NUMBER = scalar-int-variable |362// OPENED = scalar-logical-variable |363// PAD = scalar-default-char-variable |364// PENDING = scalar-logical-variable | POS = scalar-int-variable |365// POSITION = scalar-default-char-variable |366// READ = scalar-default-char-variable |367// READWRITE = scalar-default-char-variable |368// RECL = scalar-int-variable | ROUND = scalar-default-char-variable |369// SEQUENTIAL = scalar-default-char-variable |370// SIGN = scalar-default-char-variable |371// SIZE = scalar-int-variable |372// STREAM = scalar-default-char-variable |373// STATUS = scalar-default-char-variable |374// WRITE = scalar-default-char-variable375// @ | CARRIAGECONTROL = scalar-default-char-variable376// | CONVERT = scalar-default-char-variable377// | DISPOSE = scalar-default-char-variable378TYPE_PARSER(first(construct<InquireSpec>(maybe("UNIT ="_tok) >> fileUnitNumber),379 construct<InquireSpec>("FILE =" >> fileNameExpr),380 construct<InquireSpec>(381 "ACCESS =" >> construct<InquireSpec::CharVar>(382 pure(InquireSpec::CharVar::Kind::Access),383 scalarDefaultCharVariable)),384 construct<InquireSpec>(385 "ACTION =" >> construct<InquireSpec::CharVar>(386 pure(InquireSpec::CharVar::Kind::Action),387 scalarDefaultCharVariable)),388 construct<InquireSpec>(389 "ASYNCHRONOUS =" >> construct<InquireSpec::CharVar>(390 pure(InquireSpec::CharVar::Kind::Asynchronous),391 scalarDefaultCharVariable)),392 construct<InquireSpec>("BLANK =" >>393 construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Blank),394 scalarDefaultCharVariable)),395 construct<InquireSpec>(396 "DECIMAL =" >> construct<InquireSpec::CharVar>(397 pure(InquireSpec::CharVar::Kind::Decimal),398 scalarDefaultCharVariable)),399 construct<InquireSpec>("DELIM =" >>400 construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Delim),401 scalarDefaultCharVariable)),402 construct<InquireSpec>(403 "DIRECT =" >> construct<InquireSpec::CharVar>(404 pure(InquireSpec::CharVar::Kind::Direct),405 scalarDefaultCharVariable)),406 construct<InquireSpec>(407 "ENCODING =" >> construct<InquireSpec::CharVar>(408 pure(InquireSpec::CharVar::Kind::Encoding),409 scalarDefaultCharVariable)),410 construct<InquireSpec>("ERR =" >> errLabel),411 construct<InquireSpec>("EXIST =" >>412 construct<InquireSpec::LogVar>(413 pure(InquireSpec::LogVar::Kind::Exist), scalarLogicalVariable)),414 construct<InquireSpec>("FORM =" >>415 construct<InquireSpec::CharVar>(416 pure(InquireSpec::CharVar::Kind::Form), scalarDefaultCharVariable)),417 construct<InquireSpec>(418 "FORMATTED =" >> construct<InquireSpec::CharVar>(419 pure(InquireSpec::CharVar::Kind::Formatted),420 scalarDefaultCharVariable)),421 construct<InquireSpec>("ID =" >> idExpr),422 construct<InquireSpec>("IOMSG =" >>423 construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Iomsg),424 scalarDefaultCharVariable)),425 construct<InquireSpec>("IOSTAT =" >>426 construct<InquireSpec::IntVar>(pure(InquireSpec::IntVar::Kind::Iostat),427 scalar(integer(variable)))),428 construct<InquireSpec>("NAME =" >>429 construct<InquireSpec::CharVar>(430 pure(InquireSpec::CharVar::Kind::Name), scalarDefaultCharVariable)),431 construct<InquireSpec>("NAMED =" >>432 construct<InquireSpec::LogVar>(433 pure(InquireSpec::LogVar::Kind::Named), scalarLogicalVariable)),434 construct<InquireSpec>("NEXTREC =" >>435 construct<InquireSpec::IntVar>(pure(InquireSpec::IntVar::Kind::Nextrec),436 scalar(integer(variable)))),437 construct<InquireSpec>("NUMBER =" >>438 construct<InquireSpec::IntVar>(pure(InquireSpec::IntVar::Kind::Number),439 scalar(integer(variable)))),440 construct<InquireSpec>("OPENED =" >>441 construct<InquireSpec::LogVar>(442 pure(InquireSpec::LogVar::Kind::Opened), scalarLogicalVariable)),443 construct<InquireSpec>("PAD =" >>444 construct<InquireSpec::CharVar>(445 pure(InquireSpec::CharVar::Kind::Pad), scalarDefaultCharVariable)),446 construct<InquireSpec>("PENDING =" >>447 construct<InquireSpec::LogVar>(448 pure(InquireSpec::LogVar::Kind::Pending), scalarLogicalVariable)),449 construct<InquireSpec>("POS =" >>450 construct<InquireSpec::IntVar>(451 pure(InquireSpec::IntVar::Kind::Pos), scalar(integer(variable)))),452 construct<InquireSpec>(453 "POSITION =" >> construct<InquireSpec::CharVar>(454 pure(InquireSpec::CharVar::Kind::Position),455 scalarDefaultCharVariable)),456 construct<InquireSpec>("READ =" >>457 construct<InquireSpec::CharVar>(458 pure(InquireSpec::CharVar::Kind::Read), scalarDefaultCharVariable)),459 construct<InquireSpec>(460 "READWRITE =" >> construct<InquireSpec::CharVar>(461 pure(InquireSpec::CharVar::Kind::Readwrite),462 scalarDefaultCharVariable)),463 construct<InquireSpec>("RECL =" >>464 construct<InquireSpec::IntVar>(465 pure(InquireSpec::IntVar::Kind::Recl), scalar(integer(variable)))),466 construct<InquireSpec>("ROUND =" >>467 construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Round),468 scalarDefaultCharVariable)),469 construct<InquireSpec>(470 "SEQUENTIAL =" >> construct<InquireSpec::CharVar>(471 pure(InquireSpec::CharVar::Kind::Sequential),472 scalarDefaultCharVariable)),473 construct<InquireSpec>("SIGN =" >>474 construct<InquireSpec::CharVar>(475 pure(InquireSpec::CharVar::Kind::Sign), scalarDefaultCharVariable)),476 construct<InquireSpec>("SIZE =" >>477 construct<InquireSpec::IntVar>(478 pure(InquireSpec::IntVar::Kind::Size), scalar(integer(variable)))),479 construct<InquireSpec>(480 "STREAM =" >> construct<InquireSpec::CharVar>(481 pure(InquireSpec::CharVar::Kind::Stream),482 scalarDefaultCharVariable)),483 construct<InquireSpec>(484 "STATUS =" >> construct<InquireSpec::CharVar>(485 pure(InquireSpec::CharVar::Kind::Status),486 scalarDefaultCharVariable)),487 construct<InquireSpec>(488 "UNFORMATTED =" >> construct<InquireSpec::CharVar>(489 pure(InquireSpec::CharVar::Kind::Unformatted),490 scalarDefaultCharVariable)),491 construct<InquireSpec>("WRITE =" >>492 construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Write),493 scalarDefaultCharVariable)),494 extension<LanguageFeature::Carriagecontrol>(495 "nonstandard usage: CARRIAGECONTROL="_port_en_US,496 construct<InquireSpec>("CARRIAGECONTROL =" >>497 construct<InquireSpec::CharVar>(498 pure(InquireSpec::CharVar::Kind::Carriagecontrol),499 scalarDefaultCharVariable))),500 extension<LanguageFeature::Convert>(501 "nonstandard usage: CONVERT="_port_en_US,502 construct<InquireSpec>(503 "CONVERT =" >> construct<InquireSpec::CharVar>(504 pure(InquireSpec::CharVar::Kind::Convert),505 scalarDefaultCharVariable))),506 extension<LanguageFeature::Dispose>(507 "nonstandard usage: DISPOSE="_port_en_US,508 construct<InquireSpec>(509 "DISPOSE =" >> construct<InquireSpec::CharVar>(510 pure(InquireSpec::CharVar::Kind::Dispose),511 scalarDefaultCharVariable)))))512 513// R1230 inquire-stmt ->514// INQUIRE ( inquire-spec-list ) |515// INQUIRE ( IOLENGTH = scalar-int-variable ) output-item-list516TYPE_CONTEXT_PARSER("INQUIRE statement"_en_US,517 "INQUIRE" >>518 (construct<InquireStmt>(519 parenthesized(nonemptyList(Parser<InquireSpec>{}))) ||520 construct<InquireStmt>(construct<InquireStmt::Iolength>(521 parenthesized("IOLENGTH =" >> scalar(integer(variable))),522 nonemptyList(outputItem)))))523 524// R1301 format-stmt -> FORMAT format-specification525// 13.2.1 allows spaces to appear "at any point" within a format specification526// without effect, except of course within a character string edit descriptor.527TYPE_CONTEXT_PARSER("FORMAT statement"_en_US,528 construct<FormatStmt>("FORMAT" >> Parser<format::FormatSpecification>{}))529 530// R1321 char-string-edit-desc531// N.B. C1313 disallows any kind parameter on the character literal.532constexpr auto charStringEditDesc{533 space >> (charLiteralConstantWithoutKind || rawHollerithLiteral)};534 535// R1303 format-items -> format-item [[,] format-item]...536constexpr auto formatItems{537 nonemptySeparated(space >> Parser<format::FormatItem>{}, maybe(","_tok))};538 539// R1306 r -> digit-string540constexpr DigitStringIgnoreSpaces repeat;541 542// R1304 format-item ->543// [r] data-edit-desc | control-edit-desc | char-string-edit-desc |544// [r] ( format-items )545TYPE_PARSER(construct<format::FormatItem>(546 maybe(repeat), Parser<format::IntrinsicTypeDataEditDesc>{}) ||547 construct<format::FormatItem>(548 maybe(repeat), Parser<format::DerivedTypeDataEditDesc>{}) ||549 construct<format::FormatItem>(Parser<format::ControlEditDesc>{}) ||550 construct<format::FormatItem>(charStringEditDesc) ||551 construct<format::FormatItem>(maybe(repeat), parenthesized(formatItems)))552 553// R1302 format-specification ->554// ( [format-items] ) | ( [format-items ,] unlimited-format-item )555// R1305 unlimited-format-item -> * ( format-items )556// minor extension: the comma is optional before the unlimited-format-item557TYPE_PARSER(parenthesized(construct<format::FormatSpecification>(558 defaulted(formatItems / maybe(","_tok)),559 "*" >> parenthesized(formatItems)) ||560 construct<format::FormatSpecification>(defaulted(formatItems))))561// R1308 w -> digit-string562// R1309 m -> digit-string563// R1310 d -> digit-string564// R1311 e -> digit-string565constexpr auto width{repeat};566constexpr auto mandatoryWidth{construct<std::optional<int>>(width)};567constexpr auto digits{repeat};568constexpr auto noInt{construct<std::optional<int>>()};569constexpr auto mandatoryDigits{construct<std::optional<int>>("." >> width)};570 571// The extra trailing spaces in the following quoted edit descriptor token572// parsers are intentional: they inhibit any spurious warnings about missing573// spaces in pedantic mode that would otherwise be emitted if the edit574// descriptor were followed by a character that could appear in an identifier.575 576// R1307 data-edit-desc ->577// I w [. m] | B w [. m] | O w [. m] | Z w [. m] | F w . d |578// E w . d [E e] | EN w . d [E e] | ES w . d [E e] | EX w . d [E e] |579// G w [. d [E e]] | L w | A [w] | D w . d |580// DT [char-literal-constant] [( v-list )]581// (part 1 of 2)582TYPE_PARSER(construct<format::IntrinsicTypeDataEditDesc>(583 "I " >> pure(format::IntrinsicTypeDataEditDesc::Kind::I) ||584 "B " >> pure(format::IntrinsicTypeDataEditDesc::Kind::B) ||585 "O " >> pure(format::IntrinsicTypeDataEditDesc::Kind::O) ||586 "Z " >> pure(format::IntrinsicTypeDataEditDesc::Kind::Z),587 mandatoryWidth, maybe("." >> digits), noInt) ||588 construct<format::IntrinsicTypeDataEditDesc>(589 "F " >> pure(format::IntrinsicTypeDataEditDesc::Kind::F) ||590 "D " >> pure(format::IntrinsicTypeDataEditDesc::Kind::D),591 mandatoryWidth, mandatoryDigits, noInt) ||592 construct<format::IntrinsicTypeDataEditDesc>(593 "E " >> ("N " >> pure(format::IntrinsicTypeDataEditDesc::Kind::EN) ||594 "S " >> pure(format::IntrinsicTypeDataEditDesc::Kind::ES) ||595 "X " >> pure(format::IntrinsicTypeDataEditDesc::Kind::EX) ||596 pure(format::IntrinsicTypeDataEditDesc::Kind::E)),597 mandatoryWidth, mandatoryDigits, maybe("E " >> digits)) ||598 construct<format::IntrinsicTypeDataEditDesc>(599 "G " >> pure(format::IntrinsicTypeDataEditDesc::Kind::G),600 mandatoryWidth, mandatoryDigits, maybe("E " >> digits)) ||601 construct<format::IntrinsicTypeDataEditDesc>(602 "G " >> pure(format::IntrinsicTypeDataEditDesc::Kind::G) ||603 "L " >> pure(format::IntrinsicTypeDataEditDesc::Kind::L),604 mandatoryWidth, noInt, noInt) ||605 construct<format::IntrinsicTypeDataEditDesc>(606 "A " >> pure(format::IntrinsicTypeDataEditDesc::Kind::A), maybe(width),607 noInt, noInt) ||608 // PGI/Intel extension: omitting width (and all else that follows)609 // Parse them just to get them to the I/O checker in semantics;610 // they are not supported by the runtime.611 extension<LanguageFeature::AbbreviatedEditDescriptor>(construct<612 format::IntrinsicTypeDataEditDesc>(613 "I " >> pure(format::IntrinsicTypeDataEditDesc::Kind::I) ||614 ("B "_tok / !letter /* don't occlude BN & BZ */) >>615 pure(format::IntrinsicTypeDataEditDesc::Kind::B) ||616 "O " >> pure(format::IntrinsicTypeDataEditDesc::Kind::O) ||617 "Z " >> pure(format::IntrinsicTypeDataEditDesc::Kind::Z) ||618 "F " >> pure(format::IntrinsicTypeDataEditDesc::Kind::F) ||619 ("D "_tok / !letter /* don't occlude DT, DC, & DP */) >>620 pure(format::IntrinsicTypeDataEditDesc::Kind::D) ||621 "E " >>622 ("N " >> pure(format::IntrinsicTypeDataEditDesc::Kind::EN) ||623 "S " >> pure(format::IntrinsicTypeDataEditDesc::Kind::ES) ||624 "X " >> pure(format::IntrinsicTypeDataEditDesc::Kind::EX) ||625 pure(format::IntrinsicTypeDataEditDesc::Kind::E)) ||626 "G " >> pure(format::IntrinsicTypeDataEditDesc::Kind::G) ||627 "L " >> pure(format::IntrinsicTypeDataEditDesc::Kind::L),628 noInt, noInt, noInt)))629 630// R1307 data-edit-desc (part 2 of 2)631// R1312 v -> [sign] digit-string632constexpr SignedDigitStringIgnoreSpaces scaleFactor;633TYPE_PARSER(construct<format::DerivedTypeDataEditDesc>(634 "D T" >> defaulted(charLiteralConstantWithoutKind),635 defaulted(parenthesized(nonemptyList(scaleFactor)))))636 637// R1314 k -> [sign] digit-string638constexpr PositiveDigitStringIgnoreSpaces count;639 640// R1313 control-edit-desc ->641// position-edit-desc | [r] / | : | sign-edit-desc | k P |642// blank-interp-edit-desc | round-edit-desc | decimal-edit-desc |643// @ \ | $644// R1315 position-edit-desc -> T n | TL n | TR n | n X645// R1316 n -> digit-string646// R1317 sign-edit-desc -> SS | SP | S647// R1318 blank-interp-edit-desc -> BN | BZ648// R1319 round-edit-desc -> RU | RD | RZ | RN | RC | RP649// R1320 decimal-edit-desc -> DC | DP650TYPE_PARSER(construct<format::ControlEditDesc>(651 "T L " >> pure(format::ControlEditDesc::Kind::TL) ||652 "T R " >> pure(format::ControlEditDesc::Kind::TR) ||653 "T " >> pure(format::ControlEditDesc::Kind::T),654 count) ||655 construct<format::ControlEditDesc>(count,656 "X " >> pure(format::ControlEditDesc::Kind::X) ||657 "/" >> pure(format::ControlEditDesc::Kind::Slash)) ||658 construct<format::ControlEditDesc>(659 "X " >> pure(format::ControlEditDesc::Kind::X) ||660 "/" >> pure(format::ControlEditDesc::Kind::Slash)) ||661 construct<format::ControlEditDesc>(662 scaleFactor, "P " >> pure(format::ControlEditDesc::Kind::P)) ||663 construct<format::ControlEditDesc>(664 ":" >> pure(format::ControlEditDesc::Kind::Colon)) ||665 "S " >> ("S " >> construct<format::ControlEditDesc>(666 pure(format::ControlEditDesc::Kind::SS)) ||667 "P " >> construct<format::ControlEditDesc>(668 pure(format::ControlEditDesc::Kind::SP)) ||669 construct<format::ControlEditDesc>(670 pure(format::ControlEditDesc::Kind::S))) ||671 "B " >> ("N " >> construct<format::ControlEditDesc>(672 pure(format::ControlEditDesc::Kind::BN)) ||673 "Z " >> construct<format::ControlEditDesc>(674 pure(format::ControlEditDesc::Kind::BZ))) ||675 "R " >> ("U " >> construct<format::ControlEditDesc>(676 pure(format::ControlEditDesc::Kind::RU)) ||677 "D " >> construct<format::ControlEditDesc>(678 pure(format::ControlEditDesc::Kind::RD)) ||679 "Z " >> construct<format::ControlEditDesc>(680 pure(format::ControlEditDesc::Kind::RZ)) ||681 "N " >> construct<format::ControlEditDesc>(682 pure(format::ControlEditDesc::Kind::RN)) ||683 "C " >> construct<format::ControlEditDesc>(684 pure(format::ControlEditDesc::Kind::RC)) ||685 "P " >> construct<format::ControlEditDesc>(686 pure(format::ControlEditDesc::Kind::RP))) ||687 "D " >> ("C " >> construct<format::ControlEditDesc>(688 pure(format::ControlEditDesc::Kind::DC)) ||689 "P " >> construct<format::ControlEditDesc>(690 pure(format::ControlEditDesc::Kind::DP))) ||691 extension<LanguageFeature::AdditionalFormats>(692 "nonstandard usage: $ and \\ control edit descriptors"_port_en_US,693 "$" >> construct<format::ControlEditDesc>(694 pure(format::ControlEditDesc::Kind::Dollar)) ||695 "\\" >> construct<format::ControlEditDesc>(696 pure(format::ControlEditDesc::Kind::Backslash))))697} // namespace Fortran::parser698