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 "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 20 namespace Fortran::parser { 21 // R1201 io-unit -> file-unit-number | * | internal-file-variable 22 // R1203 internal-file-variable -> char-variable 23 // R905 char-variable -> variable 24 // "char-variable" is attempted first since it's not type constrained but 25 // syntactically ambiguous with "file-unit-number", which is constrained. 26 TYPE_PARSER(construct<IoUnit>(variable / lookAhead(space / ",);\n"_ch)) || 27 construct<IoUnit>(fileUnitNumber) || construct<IoUnit>(star)) 28 29 // R1202 file-unit-number -> scalar-int-expr 30 TYPE_PARSER(construct<FileUnitNumber>( 31 scalarIntExpr / (lookAhead(space >> ",)"_ch) || atEndOfStmt))) 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 constexpr auto bareUnitNumberAsList{ 306 applyFunction(singletonList<PositionOrFlushSpec>, 307 construct<PositionOrFlushSpec>(fileUnitNumber))}; 308 constexpr auto positionOrFlushSpecList{ 309 parenthesized(nonemptyList(positionOrFlushSpec)) || bareUnitNumberAsList}; 310 311 // R1224 backspace-stmt -> 312 // BACKSPACE file-unit-number | BACKSPACE ( position-spec-list ) 313 TYPE_CONTEXT_PARSER("BACKSPACE statement"_en_US, 314 construct<BackspaceStmt>("BACKSPACE" >> positionOrFlushSpecList)) 315 316 // R1225 endfile-stmt -> 317 // ENDFILE file-unit-number | ENDFILE ( position-spec-list ) 318 TYPE_CONTEXT_PARSER("ENDFILE statement"_en_US, 319 construct<EndfileStmt>("END FILE" >> positionOrFlushSpecList)) 320 321 // R1226 rewind-stmt -> REWIND file-unit-number | REWIND ( position-spec-list ) 322 TYPE_CONTEXT_PARSER("REWIND statement"_en_US, 323 construct<RewindStmt>("REWIND" >> positionOrFlushSpecList)) 324 325 // R1227 position-spec -> 326 // [UNIT =] file-unit-number | IOMSG = iomsg-variable | 327 // IOSTAT = scalar-int-variable | ERR = label 328 // R1229 flush-spec -> 329 // [UNIT =] file-unit-number | IOSTAT = scalar-int-variable | 330 // IOMSG = iomsg-variable | ERR = label 331 TYPE_PARSER( 332 construct<PositionOrFlushSpec>(maybe("UNIT ="_tok) >> fileUnitNumber) || 333 construct<PositionOrFlushSpec>("IOMSG =" >> msgVariable) || 334 construct<PositionOrFlushSpec>("IOSTAT =" >> statVariable) || 335 construct<PositionOrFlushSpec>("ERR =" >> errLabel)) 336 337 // R1228 flush-stmt -> FLUSH file-unit-number | FLUSH ( flush-spec-list ) 338 TYPE_CONTEXT_PARSER("FLUSH statement"_en_US, 339 construct<FlushStmt>("FLUSH" >> positionOrFlushSpecList)) 340 341 // R1231 inquire-spec -> 342 // [UNIT =] file-unit-number | FILE = file-name-expr | 343 // ACCESS = scalar-default-char-variable | 344 // ACTION = scalar-default-char-variable | 345 // ASYNCHRONOUS = scalar-default-char-variable | 346 // BLANK = scalar-default-char-variable | 347 // DECIMAL = scalar-default-char-variable | 348 // DELIM = scalar-default-char-variable | 349 // ENCODING = scalar-default-char-variable | 350 // ERR = label | EXIST = scalar-logical-variable | 351 // FORM = scalar-default-char-variable | 352 // FORMATTED = scalar-default-char-variable | 353 // ID = scalar-int-expr | IOMSG = iomsg-variable | 354 // IOSTAT = scalar-int-variable | 355 // NAME = scalar-default-char-variable | 356 // NAMED = scalar-logical-variable | 357 // NEXTREC = scalar-int-variable | NUMBER = scalar-int-variable | 358 // OPENED = scalar-logical-variable | 359 // PAD = scalar-default-char-variable | 360 // PENDING = scalar-logical-variable | POS = scalar-int-variable | 361 // POSITION = scalar-default-char-variable | 362 // READ = scalar-default-char-variable | 363 // READWRITE = scalar-default-char-variable | 364 // RECL = scalar-int-variable | ROUND = scalar-default-char-variable | 365 // SEQUENTIAL = scalar-default-char-variable | 366 // SIGN = scalar-default-char-variable | 367 // SIZE = scalar-int-variable | 368 // STREAM = scalar-default-char-variable | 369 // STATUS = scalar-default-char-variable | 370 // WRITE = scalar-default-char-variable 371 // @ | CARRIAGECONTROL = scalar-default-char-variable 372 // | CONVERT = scalar-default-char-variable 373 // | DISPOSE = scalar-default-char-variable 374 TYPE_PARSER(first(construct<InquireSpec>(maybe("UNIT ="_tok) >> fileUnitNumber), 375 construct<InquireSpec>("FILE =" >> fileNameExpr), 376 construct<InquireSpec>( 377 "ACCESS =" >> construct<InquireSpec::CharVar>( 378 pure(InquireSpec::CharVar::Kind::Access), 379 scalarDefaultCharVariable)), 380 construct<InquireSpec>( 381 "ACTION =" >> construct<InquireSpec::CharVar>( 382 pure(InquireSpec::CharVar::Kind::Action), 383 scalarDefaultCharVariable)), 384 construct<InquireSpec>( 385 "ASYNCHRONOUS =" >> construct<InquireSpec::CharVar>( 386 pure(InquireSpec::CharVar::Kind::Asynchronous), 387 scalarDefaultCharVariable)), 388 construct<InquireSpec>("BLANK =" >> 389 construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Blank), 390 scalarDefaultCharVariable)), 391 construct<InquireSpec>( 392 "DECIMAL =" >> construct<InquireSpec::CharVar>( 393 pure(InquireSpec::CharVar::Kind::Decimal), 394 scalarDefaultCharVariable)), 395 construct<InquireSpec>("DELIM =" >> 396 construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Delim), 397 scalarDefaultCharVariable)), 398 construct<InquireSpec>( 399 "DIRECT =" >> construct<InquireSpec::CharVar>( 400 pure(InquireSpec::CharVar::Kind::Direct), 401 scalarDefaultCharVariable)), 402 construct<InquireSpec>( 403 "ENCODING =" >> construct<InquireSpec::CharVar>( 404 pure(InquireSpec::CharVar::Kind::Encoding), 405 scalarDefaultCharVariable)), 406 construct<InquireSpec>("ERR =" >> errLabel), 407 construct<InquireSpec>("EXIST =" >> 408 construct<InquireSpec::LogVar>( 409 pure(InquireSpec::LogVar::Kind::Exist), scalarLogicalVariable)), 410 construct<InquireSpec>("FORM =" >> 411 construct<InquireSpec::CharVar>( 412 pure(InquireSpec::CharVar::Kind::Form), scalarDefaultCharVariable)), 413 construct<InquireSpec>( 414 "FORMATTED =" >> construct<InquireSpec::CharVar>( 415 pure(InquireSpec::CharVar::Kind::Formatted), 416 scalarDefaultCharVariable)), 417 construct<InquireSpec>("ID =" >> idExpr), 418 construct<InquireSpec>("IOMSG =" >> 419 construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Iomsg), 420 scalarDefaultCharVariable)), 421 construct<InquireSpec>("IOSTAT =" >> 422 construct<InquireSpec::IntVar>(pure(InquireSpec::IntVar::Kind::Iostat), 423 scalar(integer(variable)))), 424 construct<InquireSpec>("NAME =" >> 425 construct<InquireSpec::CharVar>( 426 pure(InquireSpec::CharVar::Kind::Name), scalarDefaultCharVariable)), 427 construct<InquireSpec>("NAMED =" >> 428 construct<InquireSpec::LogVar>( 429 pure(InquireSpec::LogVar::Kind::Named), scalarLogicalVariable)), 430 construct<InquireSpec>("NEXTREC =" >> 431 construct<InquireSpec::IntVar>(pure(InquireSpec::IntVar::Kind::Nextrec), 432 scalar(integer(variable)))), 433 construct<InquireSpec>("NUMBER =" >> 434 construct<InquireSpec::IntVar>(pure(InquireSpec::IntVar::Kind::Number), 435 scalar(integer(variable)))), 436 construct<InquireSpec>("OPENED =" >> 437 construct<InquireSpec::LogVar>( 438 pure(InquireSpec::LogVar::Kind::Opened), scalarLogicalVariable)), 439 construct<InquireSpec>("PAD =" >> 440 construct<InquireSpec::CharVar>( 441 pure(InquireSpec::CharVar::Kind::Pad), scalarDefaultCharVariable)), 442 construct<InquireSpec>("PENDING =" >> 443 construct<InquireSpec::LogVar>( 444 pure(InquireSpec::LogVar::Kind::Pending), scalarLogicalVariable)), 445 construct<InquireSpec>("POS =" >> 446 construct<InquireSpec::IntVar>( 447 pure(InquireSpec::IntVar::Kind::Pos), scalar(integer(variable)))), 448 construct<InquireSpec>( 449 "POSITION =" >> construct<InquireSpec::CharVar>( 450 pure(InquireSpec::CharVar::Kind::Position), 451 scalarDefaultCharVariable)), 452 construct<InquireSpec>("READ =" >> 453 construct<InquireSpec::CharVar>( 454 pure(InquireSpec::CharVar::Kind::Read), scalarDefaultCharVariable)), 455 construct<InquireSpec>( 456 "READWRITE =" >> construct<InquireSpec::CharVar>( 457 pure(InquireSpec::CharVar::Kind::Readwrite), 458 scalarDefaultCharVariable)), 459 construct<InquireSpec>("RECL =" >> 460 construct<InquireSpec::IntVar>( 461 pure(InquireSpec::IntVar::Kind::Recl), scalar(integer(variable)))), 462 construct<InquireSpec>("ROUND =" >> 463 construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Round), 464 scalarDefaultCharVariable)), 465 construct<InquireSpec>( 466 "SEQUENTIAL =" >> construct<InquireSpec::CharVar>( 467 pure(InquireSpec::CharVar::Kind::Sequential), 468 scalarDefaultCharVariable)), 469 construct<InquireSpec>("SIGN =" >> 470 construct<InquireSpec::CharVar>( 471 pure(InquireSpec::CharVar::Kind::Sign), scalarDefaultCharVariable)), 472 construct<InquireSpec>("SIZE =" >> 473 construct<InquireSpec::IntVar>( 474 pure(InquireSpec::IntVar::Kind::Size), scalar(integer(variable)))), 475 construct<InquireSpec>( 476 "STREAM =" >> construct<InquireSpec::CharVar>( 477 pure(InquireSpec::CharVar::Kind::Stream), 478 scalarDefaultCharVariable)), 479 construct<InquireSpec>( 480 "STATUS =" >> construct<InquireSpec::CharVar>( 481 pure(InquireSpec::CharVar::Kind::Status), 482 scalarDefaultCharVariable)), 483 construct<InquireSpec>( 484 "UNFORMATTED =" >> construct<InquireSpec::CharVar>( 485 pure(InquireSpec::CharVar::Kind::Unformatted), 486 scalarDefaultCharVariable)), 487 construct<InquireSpec>("WRITE =" >> 488 construct<InquireSpec::CharVar>(pure(InquireSpec::CharVar::Kind::Write), 489 scalarDefaultCharVariable)), 490 extension<LanguageFeature::Carriagecontrol>( 491 "nonstandard usage: CARRIAGECONTROL="_port_en_US, 492 construct<InquireSpec>("CARRIAGECONTROL =" >> 493 construct<InquireSpec::CharVar>( 494 pure(InquireSpec::CharVar::Kind::Carriagecontrol), 495 scalarDefaultCharVariable))), 496 extension<LanguageFeature::Convert>( 497 "nonstandard usage: CONVERT="_port_en_US, 498 construct<InquireSpec>( 499 "CONVERT =" >> construct<InquireSpec::CharVar>( 500 pure(InquireSpec::CharVar::Kind::Convert), 501 scalarDefaultCharVariable))), 502 extension<LanguageFeature::Dispose>( 503 "nonstandard usage: DISPOSE="_port_en_US, 504 construct<InquireSpec>( 505 "DISPOSE =" >> construct<InquireSpec::CharVar>( 506 pure(InquireSpec::CharVar::Kind::Dispose), 507 scalarDefaultCharVariable))))) 508 509 // R1230 inquire-stmt -> 510 // INQUIRE ( inquire-spec-list ) | 511 // INQUIRE ( IOLENGTH = scalar-int-variable ) output-item-list 512 TYPE_CONTEXT_PARSER("INQUIRE statement"_en_US, 513 "INQUIRE" >> 514 (construct<InquireStmt>( 515 parenthesized(nonemptyList(Parser<InquireSpec>{}))) || 516 construct<InquireStmt>(construct<InquireStmt::Iolength>( 517 parenthesized("IOLENGTH =" >> scalar(integer(variable))), 518 nonemptyList(outputItem))))) 519 520 // R1301 format-stmt -> FORMAT format-specification 521 // 13.2.1 allows spaces to appear "at any point" within a format specification 522 // without effect, except of course within a character string edit descriptor. 523 TYPE_CONTEXT_PARSER("FORMAT statement"_en_US, 524 construct<FormatStmt>("FORMAT" >> Parser<format::FormatSpecification>{})) 525 526 // R1321 char-string-edit-desc 527 // N.B. C1313 disallows any kind parameter on the character literal. 528 constexpr auto charStringEditDesc{ 529 space >> (charLiteralConstantWithoutKind || rawHollerithLiteral)}; 530 531 // R1303 format-items -> format-item [[,] format-item]... 532 constexpr auto formatItems{ 533 nonemptySeparated(space >> Parser<format::FormatItem>{}, maybe(","_tok))}; 534 535 // R1306 r -> digit-string 536 constexpr DigitStringIgnoreSpaces repeat; 537 538 // R1304 format-item -> 539 // [r] data-edit-desc | control-edit-desc | char-string-edit-desc | 540 // [r] ( format-items ) 541 TYPE_PARSER(construct<format::FormatItem>( 542 maybe(repeat), Parser<format::IntrinsicTypeDataEditDesc>{}) || 543 construct<format::FormatItem>( 544 maybe(repeat), Parser<format::DerivedTypeDataEditDesc>{}) || 545 construct<format::FormatItem>(Parser<format::ControlEditDesc>{}) || 546 construct<format::FormatItem>(charStringEditDesc) || 547 construct<format::FormatItem>(maybe(repeat), parenthesized(formatItems))) 548 549 // R1302 format-specification -> 550 // ( [format-items] ) | ( [format-items ,] unlimited-format-item ) 551 // R1305 unlimited-format-item -> * ( format-items ) 552 // minor extension: the comma is optional before the unlimited-format-item 553 TYPE_PARSER(parenthesized(construct<format::FormatSpecification>( 554 defaulted(formatItems / maybe(","_tok)), 555 "*" >> parenthesized(formatItems)) || 556 construct<format::FormatSpecification>(defaulted(formatItems)))) 557 // R1308 w -> digit-string 558 // R1309 m -> digit-string 559 // R1310 d -> digit-string 560 // R1311 e -> digit-string 561 constexpr auto width{repeat}; 562 constexpr auto mandatoryWidth{construct<std::optional<int>>(width)}; 563 constexpr auto digits{repeat}; 564 constexpr auto noInt{construct<std::optional<int>>()}; 565 constexpr auto mandatoryDigits{construct<std::optional<int>>("." >> width)}; 566 567 // The extra trailing spaces in the following quoted edit descriptor token 568 // parsers are intentional: they inhibit any spurious warnings about missing 569 // spaces in pedantic mode that would otherwise be emitted if the edit 570 // descriptor were followed by a character that could appear in an identifier. 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), 596 mandatoryWidth, 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 // Parse them just to get them to the I/O checker in semantics; 606 // they are not supported by the runtime. 607 extension<LanguageFeature::AbbreviatedEditDescriptor>(construct< 608 format::IntrinsicTypeDataEditDesc>( 609 "I " >> pure(format::IntrinsicTypeDataEditDesc::Kind::I) || 610 ("B "_tok / !letter /* don't occlude BN & BZ */) >> 611 pure(format::IntrinsicTypeDataEditDesc::Kind::B) || 612 "O " >> pure(format::IntrinsicTypeDataEditDesc::Kind::O) || 613 "Z " >> pure(format::IntrinsicTypeDataEditDesc::Kind::Z) || 614 "F " >> pure(format::IntrinsicTypeDataEditDesc::Kind::F) || 615 ("D "_tok / !letter /* don't occlude DT, DC, & DP */) >> 616 pure(format::IntrinsicTypeDataEditDesc::Kind::D) || 617 "E " >> 618 ("N " >> pure(format::IntrinsicTypeDataEditDesc::Kind::EN) || 619 "S " >> pure(format::IntrinsicTypeDataEditDesc::Kind::ES) || 620 "X " >> pure(format::IntrinsicTypeDataEditDesc::Kind::EX) || 621 pure(format::IntrinsicTypeDataEditDesc::Kind::E)) || 622 "G " >> pure(format::IntrinsicTypeDataEditDesc::Kind::G) || 623 "L " >> pure(format::IntrinsicTypeDataEditDesc::Kind::L), 624 noInt, noInt, noInt))) 625 626 // R1307 data-edit-desc (part 2 of 2) 627 // R1312 v -> [sign] digit-string 628 constexpr SignedDigitStringIgnoreSpaces scaleFactor; 629 TYPE_PARSER(construct<format::DerivedTypeDataEditDesc>( 630 "D T" >> defaulted(charLiteralConstantWithoutKind), 631 defaulted(parenthesized(nonemptyList(scaleFactor))))) 632 633 // R1314 k -> [sign] digit-string 634 constexpr PositiveDigitStringIgnoreSpaces count; 635 636 // R1313 control-edit-desc -> 637 // position-edit-desc | [r] / | : | sign-edit-desc | k P | 638 // blank-interp-edit-desc | round-edit-desc | decimal-edit-desc | 639 // @ \ | $ 640 // R1315 position-edit-desc -> T n | TL n | TR n | n X 641 // R1316 n -> digit-string 642 // R1317 sign-edit-desc -> SS | SP | S 643 // R1318 blank-interp-edit-desc -> BN | BZ 644 // R1319 round-edit-desc -> RU | RD | RZ | RN | RC | RP 645 // R1320 decimal-edit-desc -> DC | DP 646 TYPE_PARSER(construct<format::ControlEditDesc>( 647 "T L " >> pure(format::ControlEditDesc::Kind::TL) || 648 "T R " >> pure(format::ControlEditDesc::Kind::TR) || 649 "T " >> pure(format::ControlEditDesc::Kind::T), 650 count) || 651 construct<format::ControlEditDesc>(count, 652 "X " >> pure(format::ControlEditDesc::Kind::X) || 653 "/" >> pure(format::ControlEditDesc::Kind::Slash)) || 654 construct<format::ControlEditDesc>( 655 "X " >> pure(format::ControlEditDesc::Kind::X) || 656 "/" >> pure(format::ControlEditDesc::Kind::Slash)) || 657 construct<format::ControlEditDesc>( 658 scaleFactor, "P " >> pure(format::ControlEditDesc::Kind::P)) || 659 construct<format::ControlEditDesc>( 660 ":" >> pure(format::ControlEditDesc::Kind::Colon)) || 661 "S " >> ("S " >> construct<format::ControlEditDesc>( 662 pure(format::ControlEditDesc::Kind::SS)) || 663 "P " >> construct<format::ControlEditDesc>( 664 pure(format::ControlEditDesc::Kind::SP)) || 665 construct<format::ControlEditDesc>( 666 pure(format::ControlEditDesc::Kind::S))) || 667 "B " >> ("N " >> construct<format::ControlEditDesc>( 668 pure(format::ControlEditDesc::Kind::BN)) || 669 "Z " >> construct<format::ControlEditDesc>( 670 pure(format::ControlEditDesc::Kind::BZ))) || 671 "R " >> ("U " >> construct<format::ControlEditDesc>( 672 pure(format::ControlEditDesc::Kind::RU)) || 673 "D " >> construct<format::ControlEditDesc>( 674 pure(format::ControlEditDesc::Kind::RD)) || 675 "Z " >> construct<format::ControlEditDesc>( 676 pure(format::ControlEditDesc::Kind::RZ)) || 677 "N " >> construct<format::ControlEditDesc>( 678 pure(format::ControlEditDesc::Kind::RN)) || 679 "C " >> construct<format::ControlEditDesc>( 680 pure(format::ControlEditDesc::Kind::RC)) || 681 "P " >> construct<format::ControlEditDesc>( 682 pure(format::ControlEditDesc::Kind::RP))) || 683 "D " >> ("C " >> construct<format::ControlEditDesc>( 684 pure(format::ControlEditDesc::Kind::DC)) || 685 "P " >> construct<format::ControlEditDesc>( 686 pure(format::ControlEditDesc::Kind::DP))) || 687 extension<LanguageFeature::AdditionalFormats>( 688 "nonstandard usage: $ and \\ control edit descriptors"_port_en_US, 689 "$" >> construct<format::ControlEditDesc>( 690 pure(format::ControlEditDesc::Kind::Dollar)) || 691 "\\" >> construct<format::ControlEditDesc>( 692 pure(format::ControlEditDesc::Kind::Backslash)))) 693 } // namespace Fortran::parser 694