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