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