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