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

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