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

source code of flang/lib/Parser/io-parsers.cpp