| //===-- lib/Parser/io-parsers.cpp -----------------------------------------===// |
| // |
| // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
| // See https://llvm.org/LICENSE.txt for license information. |
| // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
| // |
| //===----------------------------------------------------------------------===// |
| |
| // Per-type parsers for I/O statements and FORMAT |
| |
| #include "basic-parsers.h" |
| #include "expr-parsers.h" |
| #include "misc-parsers.h" |
| #include "stmt-parser.h" |
| #include "token-parsers.h" |
| #include "type-parser-implementation.h" |
| #include "flang/Parser/characters.h" |
| #include "flang/Parser/parse-tree.h" |
| |
| namespace Fortran::parser { |
| // R1201 io-unit -> file-unit-number | * | internal-file-variable |
| // R1203 internal-file-variable -> char-variable |
| // R905 char-variable -> variable |
| // "char-variable" is attempted first since it's not type constrained but |
| // syntactically ambiguous with "file-unit-number", which is constrained. |
| TYPE_PARSER(construct<IoUnit>(variable / lookAhead(space / ",);\n"_ch)) || |
| construct<IoUnit>(fileUnitNumber) || construct<IoUnit>(star)) |
| |
| // R1202 file-unit-number -> scalar-int-expr |
| TYPE_PARSER(construct<FileUnitNumber>( |
| scalarIntExpr / (lookAhead(space >> ",)"_ch) || atEndOfStmt))) |
| |
| // R1204 open-stmt -> OPEN ( connect-spec-list ) |
| TYPE_CONTEXT_PARSER("OPEN statement"_en_US, |
| construct<OpenStmt>( |
| "OPEN (" >> nonemptyList("expected connection specifications"_err_en_US, |
| Parser<ConnectSpec>{}) / |
| ")")) |
| |
| // R1206 file-name-expr -> scalar-default-char-expr |
| constexpr auto fileNameExpr{scalarDefaultCharExpr}; |
| |
| // R1205 connect-spec -> |
| // [UNIT =] file-unit-number | ACCESS = scalar-default-char-expr | |
| // ACTION = scalar-default-char-expr | |
| // ASYNCHRONOUS = scalar-default-char-expr | |
| // BLANK = scalar-default-char-expr | |
| // DECIMAL = scalar-default-char-expr | |
| // DELIM = scalar-default-char-expr | |
| // ENCODING = scalar-default-char-expr | ERR = label | |
| // FILE = file-name-expr | FORM = scalar-default-char-expr | |
| // IOMSG = iomsg-variable | IOSTAT = scalar-int-variable | |
| // NEWUNIT = scalar-int-variable | PAD = scalar-default-char-expr | |
| // POSITION = scalar-default-char-expr | RECL = scalar-int-expr | |
| // ROUND = scalar-default-char-expr | SIGN = scalar-default-char-expr | |
| // STATUS = scalar-default-char-expr |
| // @ | CARRIAGECONTROL = scalar-default-char-variable |
| // | CONVERT = scalar-default-char-variable |
| // | DISPOSE = scalar-default-char-variable |
| constexpr auto statusExpr{construct<StatusExpr>(scalarDefaultCharExpr)}; |
| constexpr auto errLabel{construct<ErrLabel>(label)}; |
| |
| TYPE_PARSER(first(construct<ConnectSpec>(maybe("UNIT ="_tok) >> fileUnitNumber), |
| construct<ConnectSpec>(construct<ConnectSpec::CharExpr>( |
| "ACCESS =" >> pure(ConnectSpec::CharExpr::Kind::Access), |
| scalarDefaultCharExpr)), |
| construct<ConnectSpec>(construct<ConnectSpec::CharExpr>( |
| "ACTION =" >> pure(ConnectSpec::CharExpr::Kind::Action), |
| scalarDefaultCharExpr)), |
| construct<ConnectSpec>(construct<ConnectSpec::CharExpr>( |
| "ASYNCHRONOUS =" >> pure(ConnectSpec::CharExpr::Kind::Asynchronous), |
| scalarDefaultCharExpr)), |
| construct<ConnectSpec>(construct<ConnectSpec::CharExpr>( |
| "BLANK =" >> pure(ConnectSpec::CharExpr::Kind::Blank), |
| scalarDefaultCharExpr)), |
| construct<ConnectSpec>(construct<ConnectSpec::CharExpr>( |
| "DECIMAL =" >> pure(ConnectSpec::CharExpr::Kind::Decimal), |
| scalarDefaultCharExpr)), |
| construct<ConnectSpec>(construct<ConnectSpec::CharExpr>( |
| "DELIM =" >> pure(ConnectSpec::CharExpr::Kind::Delim), |
| scalarDefaultCharExpr)), |
| construct<ConnectSpec>(construct<ConnectSpec::CharExpr>( |
| "ENCODING =" >> pure(ConnectSpec::CharExpr::Kind::Encoding), |
| scalarDefaultCharExpr)), |
| construct<ConnectSpec>("ERR =" >> errLabel), |
| construct<ConnectSpec>("FILE =" >> fileNameExpr), |
| extension<LanguageFeature::FileName>( |
| "nonstandard usage: NAME= in place of FILE="_port_en_US, |
| construct<ConnectSpec>("NAME =" >> fileNameExpr)), |
| construct<ConnectSpec>(construct<ConnectSpec::CharExpr>( |
| "FORM =" >> pure(ConnectSpec::CharExpr::Kind::Form), |
| scalarDefaultCharExpr)), |
| construct<ConnectSpec>("IOMSG =" >> msgVariable), |
| construct<ConnectSpec>("IOSTAT =" >> statVariable), |
| construct<ConnectSpec>(construct<ConnectSpec::Newunit>( |
| "NEWUNIT =" >> scalar(integer(variable)))), |
| construct<ConnectSpec>(construct<ConnectSpec::CharExpr>( |
| "PAD =" >> pure(ConnectSpec::CharExpr::Kind::Pad), |
| scalarDefaultCharExpr)), |
| construct<ConnectSpec>(construct<ConnectSpec::CharExpr>( |
| "POSITION =" >> pure(ConnectSpec::CharExpr::Kind::Position), |
| scalarDefaultCharExpr)), |
| construct<ConnectSpec>( |
| construct<ConnectSpec::Recl>("RECL =" >> scalarIntExpr)), |
| construct<ConnectSpec>(construct<ConnectSpec::CharExpr>( |
| "ROUND =" >> pure(ConnectSpec::CharExpr::Kind::Round), |
| scalarDefaultCharExpr)), |
| construct<ConnectSpec>(construct<ConnectSpec::CharExpr>( |
| "SIGN =" >> pure(ConnectSpec::CharExpr::Kind::Sign), |
| scalarDefaultCharExpr)), |
| construct<ConnectSpec>("STATUS =" >> statusExpr), |
| extension<LanguageFeature::Carriagecontrol>( |
| "nonstandard usage: CARRIAGECONTROL="_port_en_US, |
| construct<ConnectSpec>( |
| construct<ConnectSpec::CharExpr>("CARRIAGECONTROL =" >> |
| pure(ConnectSpec::CharExpr::Kind::Carriagecontrol), |
| scalarDefaultCharExpr))), |
| extension<LanguageFeature::Convert>( |
| "nonstandard usage: CONVERT="_port_en_US, |
| construct<ConnectSpec>(construct<ConnectSpec::CharExpr>( |
| "CONVERT =" >> pure(ConnectSpec::CharExpr::Kind::Convert), |
| scalarDefaultCharExpr))), |
| extension<LanguageFeature::Dispose>( |
| "nonstandard usage: DISPOSE="_port_en_US, |
| construct<ConnectSpec>(construct<ConnectSpec::CharExpr>( |
| "DISPOSE =" >> pure(ConnectSpec::CharExpr::Kind::Dispose), |
| scalarDefaultCharExpr))))) |
| |
| // R1209 close-spec -> |
| // [UNIT =] file-unit-number | IOSTAT = scalar-int-variable | |
| // IOMSG = iomsg-variable | ERR = label | |
| // STATUS = scalar-default-char-expr |
| constexpr auto closeSpec{first( |
| construct<CloseStmt::CloseSpec>(maybe("UNIT ="_tok) >> fileUnitNumber), |
| construct<CloseStmt::CloseSpec>("IOSTAT =" >> statVariable), |
| construct<CloseStmt::CloseSpec>("IOMSG =" >> msgVariable), |
| construct<CloseStmt::CloseSpec>("ERR =" >> errLabel), |
| construct<CloseStmt::CloseSpec>("STATUS =" >> statusExpr))}; |
| |
| // R1208 close-stmt -> CLOSE ( close-spec-list ) |
| TYPE_CONTEXT_PARSER("CLOSE statement"_en_US, |
| construct<CloseStmt>("CLOSE" >> parenthesized(nonemptyList(closeSpec)))) |
| |
| // R1210 read-stmt -> |
| // READ ( io-control-spec-list ) [input-item-list] | |
| // READ format [, input-item-list] |
| // The ambiguous READ(CVAR) is parsed as if CVAR were the unit. |
| // As Fortran doesn't have internal unformatted I/O, it should |
| // be parsed as if (CVAR) were a format; this is corrected by |
| // rewriting in semantics when we know that CVAR is character. |
| constexpr auto inputItemList{ |
| extension<LanguageFeature::IOListLeadingComma>( |
| "nonstandard usage: leading comma in input item list"_port_en_US, |
| some("," >> inputItem)) || // legacy extension: leading comma |
| optionalList(inputItem)}; |
| |
| TYPE_CONTEXT_PARSER("READ statement"_en_US, |
| construct<ReadStmt>("READ (" >> |
| construct<std::optional<IoUnit>>(maybe("UNIT ="_tok) >> ioUnit), |
| "," >> construct<std::optional<Format>>(format), |
| defaulted("," >> nonemptyList(ioControlSpec)) / ")", inputItemList) || |
| construct<ReadStmt>( |
| "READ (" >> construct<std::optional<IoUnit>>(ioUnit), |
| construct<std::optional<Format>>(), |
| defaulted("," >> nonemptyList(ioControlSpec)) / ")", |
| inputItemList) || |
| construct<ReadStmt>("READ" >> construct<std::optional<IoUnit>>(), |
| construct<std::optional<Format>>(), |
| parenthesized(nonemptyList(ioControlSpec)), inputItemList) || |
| construct<ReadStmt>("READ" >> construct<std::optional<IoUnit>>(), |
| construct<std::optional<Format>>(format), |
| construct<std::list<IoControlSpec>>(), many("," >> inputItem))) |
| |
| // R1214 id-variable -> scalar-int-variable |
| constexpr auto idVariable{construct<IdVariable>(scalarIntVariable)}; |
| |
| // R1213 io-control-spec -> |
| // [UNIT =] io-unit | [FMT =] format | [NML =] namelist-group-name | |
| // ADVANCE = scalar-default-char-expr | |
| // ASYNCHRONOUS = scalar-default-char-constant-expr | |
| // BLANK = scalar-default-char-expr | |
| // DECIMAL = scalar-default-char-expr | |
| // DELIM = scalar-default-char-expr | END = label | EOR = label | |
| // ERR = label | ID = id-variable | IOMSG = iomsg-variable | |
| // IOSTAT = scalar-int-variable | PAD = scalar-default-char-expr | |
| // POS = scalar-int-expr | REC = scalar-int-expr | |
| // ROUND = scalar-default-char-expr | SIGN = scalar-default-char-expr | |
| // SIZE = scalar-int-variable |
| constexpr auto endLabel{construct<EndLabel>(label)}; |
| constexpr auto eorLabel{construct<EorLabel>(label)}; |
| TYPE_PARSER(first(construct<IoControlSpec>("UNIT =" >> ioUnit), |
| construct<IoControlSpec>("FMT =" >> format), |
| construct<IoControlSpec>("NML =" >> name), |
| construct<IoControlSpec>( |
| "ADVANCE =" >> construct<IoControlSpec::CharExpr>( |
| pure(IoControlSpec::CharExpr::Kind::Advance), |
| scalarDefaultCharExpr)), |
| construct<IoControlSpec>(construct<IoControlSpec::Asynchronous>( |
| "ASYNCHRONOUS =" >> scalarDefaultCharConstantExpr)), |
| construct<IoControlSpec>("BLANK =" >> |
| construct<IoControlSpec::CharExpr>( |
| pure(IoControlSpec::CharExpr::Kind::Blank), scalarDefaultCharExpr)), |
| construct<IoControlSpec>( |
| "DECIMAL =" >> construct<IoControlSpec::CharExpr>( |
| pure(IoControlSpec::CharExpr::Kind::Decimal), |
| scalarDefaultCharExpr)), |
| construct<IoControlSpec>("DELIM =" >> |
| construct<IoControlSpec::CharExpr>( |
| pure(IoControlSpec::CharExpr::Kind::Delim), scalarDefaultCharExpr)), |
| construct<IoControlSpec>("END =" >> endLabel), |
| construct<IoControlSpec>("EOR =" >> eorLabel), |
| construct<IoControlSpec>("ERR =" >> errLabel), |
| construct<IoControlSpec>("ID =" >> idVariable), |
| construct<IoControlSpec>("IOMSG = " >> msgVariable), |
| construct<IoControlSpec>("IOSTAT = " >> statVariable), |
| construct<IoControlSpec>("PAD =" >> |
| construct<IoControlSpec::CharExpr>( |
| pure(IoControlSpec::CharExpr::Kind::Pad), scalarDefaultCharExpr)), |
| construct<IoControlSpec>( |
| "POS =" >> construct<IoControlSpec::Pos>(scalarIntExpr)), |
| construct<IoControlSpec>( |
| "REC =" >> construct<IoControlSpec::Rec>(scalarIntExpr)), |
| construct<IoControlSpec>("ROUND =" >> |
| construct<IoControlSpec::CharExpr>( |
| pure(IoControlSpec::CharExpr::Kind::Round), scalarDefaultCharExpr)), |
| construct<IoControlSpec>("SIGN =" >> |
| construct<IoControlSpec::CharExpr>( |
| pure(IoControlSpec::CharExpr::Kind::Sign), scalarDefaultCharExpr)), |
| construct<IoControlSpec>( |
| "SIZE =" >> construct<IoControlSpec::Size>(scalarIntVariable)))) |
| |
| // R1211 write-stmt -> WRITE ( io-control-spec-list ) [output-item-list] |
| constexpr auto outputItemList{ |
| extension<LanguageFeature::IOListLeadingComma>( |
| "nonstandard usage: leading comma in output item list"_port_en_US, |
| some("," >> outputItem)) || // legacy: allow leading comma |
| optionalList(outputItem)}; |
| |
| TYPE_CONTEXT_PARSER("WRITE statement"_en_US, |
| construct<WriteStmt>("WRITE (" >> |
| construct<std::optional<IoUnit>>(maybe("UNIT ="_tok) >> ioUnit), |
| "," >> construct<std::optional<Format>>(format), |
| defaulted("," >> nonemptyList(ioControlSpec)) / ")", outputItemList) || |
| construct<WriteStmt>( |
| "WRITE (" >> construct<std::optional<IoUnit>>(ioUnit), |
| construct<std::optional<Format>>(), |
| defaulted("," >> nonemptyList(ioControlSpec)) / ")", |
| outputItemList) || |
| construct<WriteStmt>("WRITE" >> construct<std::optional<IoUnit>>(), |
| construct<std::optional<Format>>(), |
| parenthesized(nonemptyList(ioControlSpec)), outputItemList)) |
| |
| // R1212 print-stmt PRINT format [, output-item-list] |
| TYPE_CONTEXT_PARSER("PRINT statement"_en_US, |
| construct<PrintStmt>( |
| "PRINT" >> format, defaulted("," >> nonemptyList(outputItem)))) |
| |
| // R1215 format -> default-char-expr | label | * |
| // deprecated(ASSIGN): | scalar-int-name |
| TYPE_PARSER(construct<Format>(label / !"_."_ch) || |
| construct<Format>(expr / !"="_tok) || construct<Format>(star)) |
| |
| // R1216 input-item -> variable | io-implied-do |
| TYPE_PARSER(construct<InputItem>(variable) || |
| construct<InputItem>(indirect(inputImpliedDo))) |
| |
| // R1217 output-item -> expr | io-implied-do |
| TYPE_PARSER(construct<OutputItem>(expr) || |
| construct<OutputItem>(indirect(outputImpliedDo))) |
| |
| // R1220 io-implied-do-control -> |
| // do-variable = scalar-int-expr , scalar-int-expr [, scalar-int-expr] |
| constexpr auto ioImpliedDoControl{loopBounds(scalarIntExpr)}; |
| |
| // R1218 io-implied-do -> ( io-implied-do-object-list , io-implied-do-control ) |
| // R1219 io-implied-do-object -> input-item | output-item |
| TYPE_CONTEXT_PARSER("input implied DO"_en_US, |
| parenthesized( |
| construct<InputImpliedDo>(nonemptyList(inputItem / lookAhead(","_tok)), |
| "," >> ioImpliedDoControl))) |
| TYPE_CONTEXT_PARSER("output implied DO"_en_US, |
| parenthesized(construct<OutputImpliedDo>( |
| nonemptyList(outputItem / lookAhead(","_tok)), |
| "," >> ioImpliedDoControl))) |
| |
| // R1222 wait-stmt -> WAIT ( wait-spec-list ) |
| TYPE_CONTEXT_PARSER("WAIT statement"_en_US, |
| "WAIT" >> |
| parenthesized(construct<WaitStmt>(nonemptyList(Parser<WaitSpec>{})))) |
| |
| // R1223 wait-spec -> |
| // [UNIT =] file-unit-number | END = label | EOR = label | ERR = label | |
| // ID = scalar-int-expr | IOMSG = iomsg-variable | |
| // IOSTAT = scalar-int-variable |
| constexpr auto idExpr{construct<IdExpr>(scalarIntExpr)}; |
| |
| TYPE_PARSER(first(construct<WaitSpec>(maybe("UNIT ="_tok) >> fileUnitNumber), |
| construct<WaitSpec>("END =" >> endLabel), |
| construct<WaitSpec>("EOR =" >> eorLabel), |
| construct<WaitSpec>("ERR =" >> errLabel), |
| construct<WaitSpec>("ID =" >> idExpr), |
| construct<WaitSpec>("IOMSG =" >> msgVariable), |
| construct<WaitSpec>("IOSTAT =" >> statVariable))) |
| |
| constexpr auto bareUnitNumberAsList{ |
| applyFunction(singletonList<PositionOrFlushSpec>, |
| construct<PositionOrFlushSpec>(fileUnitNumber))}; |
| constexpr auto positionOrFlushSpecList{ |
| parenthesized(nonemptyList(positionOrFlushSpec)) || bareUnitNumberAsList}; |
| |
| // R1224 backspace-stmt -> |
| // BACKSPACE file-unit-number | BACKSPACE ( position-spec-list ) |
| TYPE_CONTEXT_PARSER("BACKSPACE statement"_en_US, |
| construct<BackspaceStmt>("BACKSPACE" >> positionOrFlushSpecList)) |
| |
| // R1225 endfile-stmt -> |
| // ENDFILE file-unit-number | ENDFILE ( position-spec-list ) |
| TYPE_CONTEXT_PARSER("ENDFILE statement"_en_US, |
| construct<EndfileStmt>("END FILE" >> positionOrFlushSpecList)) |
| |
| // R1226 rewind-stmt -> REWIND file-unit-number | REWIND ( position-spec-list ) |
| TYPE_CONTEXT_PARSER("REWIND statement"_en_US, |
| construct<RewindStmt>("REWIND" >> positionOrFlushSpecList)) |
| |
| // R1227 position-spec -> |
| // [UNIT =] file-unit-number | IOMSG = iomsg-variable | |
| // IOSTAT = scalar-int-variable | ERR = label |
| // R1229 flush-spec -> |
| // [UNIT =] file-unit-number | IOSTAT = scalar-int-variable | |
| // IOMSG = iomsg-variable | ERR = label |
| TYPE_PARSER( |
| construct<PositionOrFlushSpec>(maybe("UNIT ="_tok) >> fileUnitNumber) || |
| construct<PositionOrFlushSpec>("IOMSG =" >> msgVariable) || |
| construct<PositionOrFlushSpec>("IOSTAT =" >> statVariable) || |
| construct<PositionOrFlushSpec>("ERR =" >> errLabel)) |
| |
| // R1228 flush-stmt -> FLUSH file-unit-number | FLUSH ( flush-spec-list ) |
| TYPE_CONTEXT_PARSER("FLUSH statement"_en_US, |
| construct<FlushStmt>("FLUSH" >> positionOrFlushSpecList)) |
| |
| // R1231 inquire-spec -> |
| // [UNIT =] file-unit-number | FILE = file-name-expr | |
| // ACCESS = scalar-default-char-variable | |
| // ACTION = scalar-default-char-variable | |
| // ASYNCHRONOUS = scalar-default-char-variable | |
| // BLANK = scalar-default-char-variable | |
| // DECIMAL = scalar-default-char-variable | |
| // DELIM = scalar-default-char-variable | |
| // ENCODING = scalar-default-char-variable | |
| // ERR = label | EXIST = scalar-logical-variable | |
| // FORM = scalar-default-char-variable | |
| // FORMATTED = scalar-default-char-variable | |
| // ID = scalar-int-expr | IOMSG = iomsg-variable | |
| // IOSTAT = scalar-int-variable | |
| // NAME = scalar-default-char-variable | |
| // NAMED = scalar-logical-variable | |
| // NEXTREC = scalar-int-variable | NUMBER = scalar-int-variable | |
| // OPENED = scalar-logical-variable | |
| // PAD = scalar-default-char-variable | |
| // PENDING = scalar-logical-variable | POS = scalar-int-variable | |
| // POSITION = scalar-default-char-variable | |
| // READ = scalar-default-char-variable | |
| // READWRITE = scalar-default-char-variable | |
| // RECL = scalar-int-variable | ROUND = scalar-default-char-variable | |
| // SEQUENTIAL = scalar-default-char-variable | |
| // SIGN = scalar-default-char-variable | |
| // SIZE = scalar-int-variable | |
| // STREAM = scalar-default-char-variable | |
| // STATUS = scalar-default-char-variable | |
| // WRITE = scalar-default-char-variable |
| // @ | CARRIAGECONTROL = scalar-default-char-variable |
| // | CONVERT = scalar-default-char-variable |
| // | DISPOSE = scalar-default-char-variable |
| TYPE_PARSER(first(construct<InquireSpec>(maybe("UNIT ="_tok) >> fileUnitNumber), |
| construct<InquireSpec>("FILE =" >> fileNameExpr), |
| construct<InquireSpec>( |
| "ACCESS =" >> construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Access), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>( |
| "ACTION =" >> construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Action), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>( |
| "ASYNCHRONOUS =" >> construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Asynchronous), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>("BLANK =" >> |
| construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Blank), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>( |
| "DECIMAL =" >> construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Decimal), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>("DELIM =" >> |
| construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Delim), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>( |
| "DIRECT =" >> construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Direct), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>( |
| "ENCODING =" >> construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Encoding), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>("ERR =" >> errLabel), |
| construct<InquireSpec>("EXIST =" >> |
| construct<InquireSpec::LogVar>( |
| pure(InquireSpec::LogVar::Kind::Exist), scalarLogicalVariable)), |
| construct<InquireSpec>("FORM =" >> |
| construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Form), scalarDefaultCharVariable)), |
| construct<InquireSpec>( |
| "FORMATTED =" >> construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Formatted), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>("ID =" >> idExpr), |
| construct<InquireSpec>("IOMSG =" >> |
| construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Iomsg), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>("IOSTAT =" >> |
| construct<InquireSpec::IntVar>(pure(InquireSpec::IntVar::Kind::Iostat), |
| scalar(integer(variable)))), |
| construct<InquireSpec>("NAME =" >> |
| construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Name), scalarDefaultCharVariable)), |
| construct<InquireSpec>("NAMED =" >> |
| construct<InquireSpec::LogVar>( |
| pure(InquireSpec::LogVar::Kind::Named), scalarLogicalVariable)), |
| construct<InquireSpec>("NEXTREC =" >> |
| construct<InquireSpec::IntVar>(pure(InquireSpec::IntVar::Kind::Nextrec), |
| scalar(integer(variable)))), |
| construct<InquireSpec>("NUMBER =" >> |
| construct<InquireSpec::IntVar>(pure(InquireSpec::IntVar::Kind::Number), |
| scalar(integer(variable)))), |
| construct<InquireSpec>("OPENED =" >> |
| construct<InquireSpec::LogVar>( |
| pure(InquireSpec::LogVar::Kind::Opened), scalarLogicalVariable)), |
| construct<InquireSpec>("PAD =" >> |
| construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Pad), scalarDefaultCharVariable)), |
| construct<InquireSpec>("PENDING =" >> |
| construct<InquireSpec::LogVar>( |
| pure(InquireSpec::LogVar::Kind::Pending), scalarLogicalVariable)), |
| construct<InquireSpec>("POS =" >> |
| construct<InquireSpec::IntVar>( |
| pure(InquireSpec::IntVar::Kind::Pos), scalar(integer(variable)))), |
| construct<InquireSpec>( |
| "POSITION =" >> construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Position), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>("READ =" >> |
| construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Read), scalarDefaultCharVariable)), |
| construct<InquireSpec>( |
| "READWRITE =" >> construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Readwrite), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>("RECL =" >> |
| construct<InquireSpec::IntVar>( |
| pure(InquireSpec::IntVar::Kind::Recl), scalar(integer(variable)))), |
| construct<InquireSpec>("ROUND =" >> |
| construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Round), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>( |
| "SEQUENTIAL =" >> construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Sequential), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>("SIGN =" >> |
| construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Sign), scalarDefaultCharVariable)), |
| construct<InquireSpec>("SIZE =" >> |
| construct<InquireSpec::IntVar>( |
| pure(InquireSpec::IntVar::Kind::Size), scalar(integer(variable)))), |
| construct<InquireSpec>( |
| "STREAM =" >> construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Stream), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>( |
| "STATUS =" >> construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Status), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>( |
| "UNFORMATTED =" >> construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Unformatted), |
| scalarDefaultCharVariable)), |
| construct<InquireSpec>("WRITE =" >> |
| construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Write), |
| scalarDefaultCharVariable)), |
| extension<LanguageFeature::Carriagecontrol>( |
| "nonstandard usage: CARRIAGECONTROL="_port_en_US, |
| construct<InquireSpec>("CARRIAGECONTROL =" >> |
| construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Carriagecontrol), |
| scalarDefaultCharVariable))), |
| extension<LanguageFeature::Convert>( |
| "nonstandard usage: CONVERT="_port_en_US, |
| construct<InquireSpec>( |
| "CONVERT =" >> construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Convert), |
| scalarDefaultCharVariable))), |
| extension<LanguageFeature::Dispose>( |
| "nonstandard usage: DISPOSE="_port_en_US, |
| construct<InquireSpec>( |
| "DISPOSE =" >> construct<InquireSpec::CharVar>( |
| pure(InquireSpec::CharVar::Kind::Dispose), |
| scalarDefaultCharVariable))))) |
| |
| // R1230 inquire-stmt -> |
| // INQUIRE ( inquire-spec-list ) | |
| // INQUIRE ( IOLENGTH = scalar-int-variable ) output-item-list |
| TYPE_CONTEXT_PARSER("INQUIRE statement"_en_US, |
| "INQUIRE" >> |
| (construct<InquireStmt>( |
| parenthesized(nonemptyList(Parser<InquireSpec>{}))) || |
| construct<InquireStmt>(construct<InquireStmt::Iolength>( |
| parenthesized("IOLENGTH =" >> scalar(integer(variable))), |
| nonemptyList(outputItem))))) |
| |
| // R1301 format-stmt -> FORMAT format-specification |
| // 13.2.1 allows spaces to appear "at any point" within a format specification |
| // without effect, except of course within a character string edit descriptor. |
| TYPE_CONTEXT_PARSER("FORMAT statement"_en_US, |
| construct<FormatStmt>("FORMAT" >> Parser<format::FormatSpecification>{})) |
| |
| // R1321 char-string-edit-desc |
| // N.B. C1313 disallows any kind parameter on the character literal. |
| constexpr auto charStringEditDesc{ |
| space >> (charLiteralConstantWithoutKind || rawHollerithLiteral)}; |
| |
| // R1303 format-items -> format-item [[,] format-item]... |
| constexpr auto formatItems{ |
| nonemptySeparated(space >> Parser<format::FormatItem>{}, maybe(","_tok))}; |
| |
| // R1306 r -> digit-string |
| constexpr DigitStringIgnoreSpaces repeat; |
| |
| // R1304 format-item -> |
| // [r] data-edit-desc | control-edit-desc | char-string-edit-desc | |
| // [r] ( format-items ) |
| TYPE_PARSER(construct<format::FormatItem>( |
| maybe(repeat), Parser<format::IntrinsicTypeDataEditDesc>{}) || |
| construct<format::FormatItem>( |
| maybe(repeat), Parser<format::DerivedTypeDataEditDesc>{}) || |
| construct<format::FormatItem>(Parser<format::ControlEditDesc>{}) || |
| construct<format::FormatItem>(charStringEditDesc) || |
| construct<format::FormatItem>(maybe(repeat), parenthesized(formatItems))) |
| |
| // R1302 format-specification -> |
| // ( [format-items] ) | ( [format-items ,] unlimited-format-item ) |
| // R1305 unlimited-format-item -> * ( format-items ) |
| // minor extension: the comma is optional before the unlimited-format-item |
| TYPE_PARSER(parenthesized(construct<format::FormatSpecification>( |
| defaulted(formatItems / maybe(","_tok)), |
| "*" >> parenthesized(formatItems)) || |
| construct<format::FormatSpecification>(defaulted(formatItems)))) |
| // R1308 w -> digit-string |
| // R1309 m -> digit-string |
| // R1310 d -> digit-string |
| // R1311 e -> digit-string |
| constexpr auto width{repeat}; |
| constexpr auto mandatoryWidth{construct<std::optional<int>>(width)}; |
| constexpr auto digits{repeat}; |
| constexpr auto noInt{construct<std::optional<int>>()}; |
| constexpr auto mandatoryDigits{construct<std::optional<int>>("." >> width)}; |
| |
| // The extra trailing spaces in the following quoted edit descriptor token |
| // parsers are intentional: they inhibit any spurious warnings about missing |
| // spaces in pedantic mode that would otherwise be emitted if the edit |
| // descriptor were followed by a character that could appear in an identifier. |
| |
| // R1307 data-edit-desc -> |
| // I w [. m] | B w [. m] | O w [. m] | Z w [. m] | F w . d | |
| // E w . d [E e] | EN w . d [E e] | ES w . d [E e] | EX w . d [E e] | |
| // G w [. d [E e]] | L w | A [w] | D w . d | |
| // DT [char-literal-constant] [( v-list )] |
| // (part 1 of 2) |
| TYPE_PARSER(construct<format::IntrinsicTypeDataEditDesc>( |
| "I " >> pure(format::IntrinsicTypeDataEditDesc::Kind::I) || |
| "B " >> pure(format::IntrinsicTypeDataEditDesc::Kind::B) || |
| "O " >> pure(format::IntrinsicTypeDataEditDesc::Kind::O) || |
| "Z " >> pure(format::IntrinsicTypeDataEditDesc::Kind::Z), |
| mandatoryWidth, maybe("." >> digits), noInt) || |
| construct<format::IntrinsicTypeDataEditDesc>( |
| "F " >> pure(format::IntrinsicTypeDataEditDesc::Kind::F) || |
| "D " >> pure(format::IntrinsicTypeDataEditDesc::Kind::D), |
| mandatoryWidth, mandatoryDigits, noInt) || |
| construct<format::IntrinsicTypeDataEditDesc>( |
| "E " >> ("N " >> pure(format::IntrinsicTypeDataEditDesc::Kind::EN) || |
| "S " >> pure(format::IntrinsicTypeDataEditDesc::Kind::ES) || |
| "X " >> pure(format::IntrinsicTypeDataEditDesc::Kind::EX) || |
| pure(format::IntrinsicTypeDataEditDesc::Kind::E)), |
| mandatoryWidth, mandatoryDigits, maybe("E " >> digits)) || |
| construct<format::IntrinsicTypeDataEditDesc>( |
| "G " >> pure(format::IntrinsicTypeDataEditDesc::Kind::G), |
| mandatoryWidth, mandatoryDigits, maybe("E " >> digits)) || |
| construct<format::IntrinsicTypeDataEditDesc>( |
| "G " >> pure(format::IntrinsicTypeDataEditDesc::Kind::G) || |
| "L " >> pure(format::IntrinsicTypeDataEditDesc::Kind::L), |
| mandatoryWidth, noInt, noInt) || |
| construct<format::IntrinsicTypeDataEditDesc>( |
| "A " >> pure(format::IntrinsicTypeDataEditDesc::Kind::A), maybe(width), |
| noInt, noInt) || |
| // PGI/Intel extension: omitting width (and all else that follows) |
| // Parse them just to get them to the I/O checker in semantics; |
| // they are not supported by the runtime. |
| extension<LanguageFeature::AbbreviatedEditDescriptor>(construct< |
| format::IntrinsicTypeDataEditDesc>( |
| "I " >> pure(format::IntrinsicTypeDataEditDesc::Kind::I) || |
| ("B "_tok / !letter /* don't occlude BN & BZ */) >> |
| pure(format::IntrinsicTypeDataEditDesc::Kind::B) || |
| "O " >> pure(format::IntrinsicTypeDataEditDesc::Kind::O) || |
| "Z " >> pure(format::IntrinsicTypeDataEditDesc::Kind::Z) || |
| "F " >> pure(format::IntrinsicTypeDataEditDesc::Kind::F) || |
| ("D "_tok / !letter /* don't occlude DT, DC, & DP */) >> |
| pure(format::IntrinsicTypeDataEditDesc::Kind::D) || |
| "E " >> |
| ("N " >> pure(format::IntrinsicTypeDataEditDesc::Kind::EN) || |
| "S " >> pure(format::IntrinsicTypeDataEditDesc::Kind::ES) || |
| "X " >> pure(format::IntrinsicTypeDataEditDesc::Kind::EX) || |
| pure(format::IntrinsicTypeDataEditDesc::Kind::E)) || |
| "G " >> pure(format::IntrinsicTypeDataEditDesc::Kind::G) || |
| "L " >> pure(format::IntrinsicTypeDataEditDesc::Kind::L), |
| noInt, noInt, noInt))) |
| |
| // R1307 data-edit-desc (part 2 of 2) |
| // R1312 v -> [sign] digit-string |
| constexpr SignedDigitStringIgnoreSpaces scaleFactor; |
| TYPE_PARSER(construct<format::DerivedTypeDataEditDesc>( |
| "D T" >> defaulted(charLiteralConstantWithoutKind), |
| defaulted(parenthesized(nonemptyList(scaleFactor))))) |
| |
| // R1314 k -> [sign] digit-string |
| constexpr PositiveDigitStringIgnoreSpaces count; |
| |
| // R1313 control-edit-desc -> |
| // position-edit-desc | [r] / | : | sign-edit-desc | k P | |
| // blank-interp-edit-desc | round-edit-desc | decimal-edit-desc | |
| // @ \ | $ |
| // R1315 position-edit-desc -> T n | TL n | TR n | n X |
| // R1316 n -> digit-string |
| // R1317 sign-edit-desc -> SS | SP | S |
| // R1318 blank-interp-edit-desc -> BN | BZ |
| // R1319 round-edit-desc -> RU | RD | RZ | RN | RC | RP |
| // R1320 decimal-edit-desc -> DC | DP |
| TYPE_PARSER(construct<format::ControlEditDesc>( |
| "T L " >> pure(format::ControlEditDesc::Kind::TL) || |
| "T R " >> pure(format::ControlEditDesc::Kind::TR) || |
| "T " >> pure(format::ControlEditDesc::Kind::T), |
| count) || |
| construct<format::ControlEditDesc>(count, |
| "X " >> pure(format::ControlEditDesc::Kind::X) || |
| "/" >> pure(format::ControlEditDesc::Kind::Slash)) || |
| construct<format::ControlEditDesc>( |
| "X " >> pure(format::ControlEditDesc::Kind::X) || |
| "/" >> pure(format::ControlEditDesc::Kind::Slash)) || |
| construct<format::ControlEditDesc>( |
| scaleFactor, "P " >> pure(format::ControlEditDesc::Kind::P)) || |
| construct<format::ControlEditDesc>( |
| ":" >> pure(format::ControlEditDesc::Kind::Colon)) || |
| "S " >> ("S " >> construct<format::ControlEditDesc>( |
| pure(format::ControlEditDesc::Kind::SS)) || |
| "P " >> construct<format::ControlEditDesc>( |
| pure(format::ControlEditDesc::Kind::SP)) || |
| construct<format::ControlEditDesc>( |
| pure(format::ControlEditDesc::Kind::S))) || |
| "B " >> ("N " >> construct<format::ControlEditDesc>( |
| pure(format::ControlEditDesc::Kind::BN)) || |
| "Z " >> construct<format::ControlEditDesc>( |
| pure(format::ControlEditDesc::Kind::BZ))) || |
| "R " >> ("U " >> construct<format::ControlEditDesc>( |
| pure(format::ControlEditDesc::Kind::RU)) || |
| "D " >> construct<format::ControlEditDesc>( |
| pure(format::ControlEditDesc::Kind::RD)) || |
| "Z " >> construct<format::ControlEditDesc>( |
| pure(format::ControlEditDesc::Kind::RZ)) || |
| "N " >> construct<format::ControlEditDesc>( |
| pure(format::ControlEditDesc::Kind::RN)) || |
| "C " >> construct<format::ControlEditDesc>( |
| pure(format::ControlEditDesc::Kind::RC)) || |
| "P " >> construct<format::ControlEditDesc>( |
| pure(format::ControlEditDesc::Kind::RP))) || |
| "D " >> ("C " >> construct<format::ControlEditDesc>( |
| pure(format::ControlEditDesc::Kind::DC)) || |
| "P " >> construct<format::ControlEditDesc>( |
| pure(format::ControlEditDesc::Kind::DP))) || |
| extension<LanguageFeature::AdditionalFormats>( |
| "nonstandard usage: $ and \\ control edit descriptors"_port_en_US, |
| "$" >> construct<format::ControlEditDesc>( |
| pure(format::ControlEditDesc::Kind::Dollar)) || |
| "\\" >> construct<format::ControlEditDesc>( |
| pure(format::ControlEditDesc::Kind::Backslash)))) |
| } // namespace Fortran::parser |
