713 lines · c
1//===-- lib/Parser/token-parsers.h ------------------------------*- C++ -*-===//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-exception6//7//===----------------------------------------------------------------------===//8 9#ifndef FORTRAN_PARSER_TOKEN_PARSERS_H_10#define FORTRAN_PARSER_TOKEN_PARSERS_H_11 12// These parsers are driven by the parsers of the Fortran grammar to consume13// the prescanned character stream and recognize context-sensitive tokens.14 15#include "basic-parsers.h"16#include "type-parsers.h"17#include "flang/Common/idioms.h"18#include "flang/Parser/char-set.h"19#include "flang/Parser/characters.h"20#include "flang/Parser/instrumented-parser.h"21#include "flang/Parser/provenance.h"22#include <cstddef>23#include <cstring>24#include <functional>25#include <limits>26#include <list>27#include <optional>28#include <string>29 30namespace Fortran::parser {31 32// "xyz"_ch matches one instance of the characters x, y, or z without skipping33// any spaces before or after. The parser returns the location of the character34// on success.35class AnyOfChars {36public:37 using resultType = const char *;38 constexpr AnyOfChars(const AnyOfChars &) = default;39 constexpr AnyOfChars(SetOfChars set) : set_{set} {}40 std::optional<const char *> Parse(ParseState &state) const {41 if (std::optional<const char *> at{state.PeekAtNextChar()}) {42 if (set_.Has(**at)) {43 state.UncheckedAdvance();44 state.set_anyTokenMatched();45 return at;46 }47 }48 state.Say(MessageExpectedText{set_});49 return std::nullopt;50 }51 52private:53 const SetOfChars set_;54};55 56constexpr AnyOfChars operator""_ch(const char str[], std::size_t n) {57 return AnyOfChars{SetOfChars(str, n)};58}59 60constexpr auto letter{"abcdefghijklmnopqrstuvwxyz"_ch};61constexpr auto digit{"0123456789"_ch};62 63// Skips over optional spaces. Always succeeds.64struct Space {65 using resultType = Success;66 constexpr Space() {}67 static std::optional<Success> Parse(ParseState &state) {68 while (std::optional<const char *> p{state.PeekAtNextChar()}) {69 if (**p != ' ') {70 break;71 }72 state.UncheckedAdvance();73 }74 return {Success{}};75 }76};77constexpr Space space;78 79// Skips a space that in free form requires a warning if it precedes a80// character that could begin an identifier or keyword. Always succeeds.81inline void MissingSpace(ParseState &state) {82 if (!state.inFixedForm()) {83 state.Nonstandard(84 LanguageFeature::OptionalFreeFormSpace, "missing space"_port_en_US);85 }86}87 88struct SpaceCheck {89 using resultType = Success;90 constexpr SpaceCheck() {}91 static std::optional<Success> Parse(ParseState &state) {92 if (std::optional<const char *> p{state.PeekAtNextChar()}) {93 char ch{**p};94 if (ch == ' ') {95 state.UncheckedAdvance();96 return space.Parse(state);97 }98 if (IsLegalInIdentifier(ch)) {99 MissingSpace(state);100 }101 }102 return {Success{}};103 }104};105constexpr SpaceCheck spaceCheck;106 107// Matches a token string. Spaces in the token string denote where108// spaces may appear in the source; they can be made mandatory for109// some free form keyword sequences. Missing mandatory spaces in free110// form elicit a warning; they are not necessary for recognition.111// Spaces before and after the token are also skipped.112//113// Token strings appear in the grammar as C++ user-defined literals114// like "BIND ( C )"_tok and "SYNC ALL"_sptok. The _tok suffix is implied115// when a string literal appears before the sequencing operator >> or116// after the sequencing operator /. The literal "..."_id parses a117// token that cannot be a prefix of a longer identifier.118template <bool MandatoryFreeFormSpace = false, bool MustBeComplete = false>119class TokenStringMatch {120public:121 using resultType = Success;122 constexpr TokenStringMatch(const TokenStringMatch &) = default;123 constexpr TokenStringMatch(const char *str, std::size_t n)124 : str_{str}, bytes_{n} {}125 explicit constexpr TokenStringMatch(const char *str) : str_{str} {}126 std::optional<Success> Parse(ParseState &state) const {127 space.Parse(state);128 const char *start{state.GetLocation()};129 const char *p{str_};130 std::optional<const char *> at; // initially empty131 for (std::size_t j{0}; j < bytes_ && *p != '\0'; ++j, ++p) {132 bool spaceSkipping{*p == ' '};133 if (spaceSkipping) {134 if (j + 1 == bytes_ || p[1] == ' ' || p[1] == '\0') {135 continue; // redundant; ignore136 }137 }138 if (!at) {139 at = nextCh.Parse(state);140 if (!at) {141 return std::nullopt;142 }143 }144 if (spaceSkipping) {145 if (**at == ' ') {146 at = nextCh.Parse(state);147 if (!at) {148 return std::nullopt;149 }150 } else if constexpr (MandatoryFreeFormSpace) {151 MissingSpace(state);152 }153 // 'at' remains full for next iteration154 } else if (**at == ToLowerCaseLetter(*p)) {155 at.reset();156 } else {157 state.Say(start, MessageExpectedText{str_, bytes_});158 return std::nullopt;159 }160 }161 if constexpr (MustBeComplete) {162 if (auto after{state.PeekAtNextChar()}) {163 if (IsLegalInIdentifier(**after)) {164 state.Say(start, MessageExpectedText{str_, bytes_});165 return std::nullopt;166 }167 }168 }169 state.set_anyTokenMatched();170 if (IsLegalInIdentifier(p[-1])) {171 return spaceCheck.Parse(state);172 } else {173 return space.Parse(state);174 }175 }176 177private:178 const char *const str_;179 const std::size_t bytes_{std::string::npos};180};181 182constexpr TokenStringMatch<> operator""_tok(const char str[], std::size_t n) {183 return {str, n};184}185 186constexpr TokenStringMatch<true> operator""_sptok(187 const char str[], std::size_t n) {188 return {str, n};189}190 191constexpr TokenStringMatch<false, true> operator""_id(192 const char str[], std::size_t n) {193 return {str, n};194}195 196template <class PA>197inline constexpr std::enable_if_t<std::is_class_v<PA>,198 SequenceParser<TokenStringMatch<>, PA>>199operator>>(const char *str, const PA &p) {200 return SequenceParser<TokenStringMatch<>, PA>{TokenStringMatch<>{str}, p};201}202 203template <class PA>204inline constexpr std::enable_if_t<std::is_class_v<PA>,205 FollowParser<PA, TokenStringMatch<>>>206operator/(const PA &p, const char *str) {207 return FollowParser<PA, TokenStringMatch<>>{p, TokenStringMatch<>{str}};208}209 210template <class PA> inline constexpr auto parenthesized(const PA &p) {211 return "(" >> p / ")";212}213 214template <class PA> inline constexpr auto bracketed(const PA &p) {215 return "[" >> p / "]";216}217 218template <class PA> inline constexpr auto braced(const PA &p) {219 return "{" >> p / "}";220}221 222// Quoted character literal constants.223struct CharLiteralChar {224 using resultType = std::pair<char, bool /* was escaped */>;225 static std::optional<resultType> Parse(ParseState &state) {226 auto at{state.GetLocation()};227 if (std::optional<const char *> cp{nextCh.Parse(state)}) {228 char ch{**cp};229 if (ch == '\n') {230 state.Say(CharBlock{at, state.GetLocation()},231 "Unclosed character constant"_err_en_US);232 return std::nullopt;233 }234 if (ch == '\\') {235 // Most escape sequences in character literals are processed later,236 // but we have to look for quotes here so that doubled quotes work.237 if (std::optional<const char *> next{state.PeekAtNextChar()}) {238 char escaped{**next};239 if (escaped == '\'' || escaped == '"' || escaped == '\\') {240 state.UncheckedAdvance();241 return std::make_pair(escaped, true);242 }243 }244 }245 return std::make_pair(ch, false);246 }247 return std::nullopt;248 }249};250 251template <char quote> struct CharLiteral {252 using resultType = std::string;253 static std::optional<std::string> Parse(ParseState &state) {254 std::string str;255 static constexpr auto nextch{attempt(CharLiteralChar{})};256 while (auto ch{nextch.Parse(state)}) {257 if (ch->second) {258 str += '\\';259 } else if (ch->first == quote) {260 static constexpr auto doubled{attempt(AnyOfChars{SetOfChars{quote}})};261 if (!doubled.Parse(state)) {262 return str;263 }264 }265 str += ch->first;266 }267 return std::nullopt;268 }269};270 271// Parse "BOZ" binary literal quoted constants.272// As extensions, support X as an alternate hexadecimal marker, and allow273// BOZX markers to appear as suffixes.274struct BOZLiteral {275 using resultType = std::string;276 static std::optional<resultType> Parse(ParseState &state) {277 char base{'\0'};278 auto baseChar{[&base](char ch) -> bool {279 switch (ch) {280 case 'b':281 case 'o':282 case 'z':283 base = ch;284 return true;285 case 'x':286 base = 'z';287 return true;288 default:289 return false;290 }291 }};292 293 space.Parse(state);294 const char *start{state.GetLocation()};295 std::optional<const char *> at{nextCh.Parse(state)};296 if (!at) {297 return std::nullopt;298 }299 if (**at == 'x' &&300 !state.IsNonstandardOk(LanguageFeature::BOZExtensions,301 "nonstandard BOZ literal"_port_en_US)) {302 return std::nullopt;303 }304 if (baseChar(**at)) {305 at = nextCh.Parse(state);306 if (!at) {307 return std::nullopt;308 }309 }310 311 char quote = **at;312 if (quote != '\'' && quote != '"') {313 return std::nullopt;314 }315 316 std::string content;317 while (true) {318 at = nextCh.Parse(state);319 if (!at) {320 return std::nullopt;321 }322 if (**at == quote) {323 break;324 }325 if (**at == ' ') {326 continue;327 }328 if (!IsHexadecimalDigit(**at)) {329 return std::nullopt;330 }331 content += ToLowerCaseLetter(**at);332 }333 334 if (!base) {335 // extension: base allowed to appear as suffix, too336 if (!(at = nextCh.Parse(state)) || !baseChar(**at) ||337 !state.IsNonstandardOk(LanguageFeature::BOZExtensions,338 "nonstandard BOZ literal"_port_en_US)) {339 return std::nullopt;340 }341 spaceCheck.Parse(state);342 }343 344 if (content.empty()) {345 state.Say(start, "no digit in BOZ literal"_err_en_US);346 return std::nullopt;347 }348 return {std::string{base} + '"' + content + '"'};349 }350};351 352// R711 digit-string -> digit [digit]...353// N.B. not a token -- no space is skipped354struct DigitString {355 using resultType = CharBlock;356 static std::optional<resultType> Parse(ParseState &state) {357 if (std::optional<const char *> ch1{state.PeekAtNextChar()}) {358 if (IsDecimalDigit(**ch1)) {359 state.UncheckedAdvance();360 while (std::optional<const char *> p{state.PeekAtNextChar()}) {361 if (!IsDecimalDigit(**p)) {362 break;363 }364 state.UncheckedAdvance();365 }366 return CharBlock{*ch1, state.GetLocation()};367 }368 }369 return std::nullopt;370 }371};372constexpr DigitString digitString;373 374struct SignedIntLiteralConstantWithoutKind {375 using resultType = CharBlock;376 static std::optional<resultType> Parse(ParseState &state) {377 resultType result{state.GetLocation()};378 static constexpr auto sign{maybe("+-"_ch / space)};379 if (sign.Parse(state)) {380 if (auto digits{digitString.Parse(state)}) {381 result.ExtendToCover(*digits);382 return result;383 }384 }385 return std::nullopt;386 }387};388 389struct DigitString64 {390 using resultType = std::uint64_t;391 static std::optional<std::uint64_t> Parse(ParseState &state) {392 std::optional<const char *> firstDigit{digit.Parse(state)};393 if (!firstDigit) {394 return std::nullopt;395 }396 std::uint64_t value = **firstDigit - '0';397 bool overflow{false};398 static constexpr auto getDigit{attempt(digit)};399 while (auto nextDigit{getDigit.Parse(state)}) {400 if (value > std::numeric_limits<std::uint64_t>::max() / 10) {401 overflow = true;402 }403 value *= 10;404 int digitValue = **nextDigit - '0';405 if (value > std::numeric_limits<std::uint64_t>::max() - digitValue) {406 overflow = true;407 }408 value += digitValue;409 }410 if (overflow) {411 state.Say(*firstDigit, "overflow in decimal literal"_err_en_US);412 }413 return {value};414 }415};416constexpr DigitString64 digitString64;417 418// R707 signed-int-literal-constant -> [sign] int-literal-constant419// N.B. Spaces are consumed before and after the sign, since the sign420// and the int-literal-constant are distinct tokens. Does not421// handle a trailing kind parameter.422static std::optional<std::int64_t> SignedInteger(423 const std::optional<std::uint64_t> &x, Location at, bool negate,424 ParseState &state) {425 if (!x) {426 return std::nullopt;427 }428 std::uint64_t limit{std::numeric_limits<std::int64_t>::max()};429 if (negate) {430 limit = -(limit + 1);431 }432 if (*x > limit) {433 state.Say(at, "overflow in signed decimal literal"_err_en_US);434 }435 std::int64_t value = *x;436 return std::make_optional<std::int64_t>(negate ? -value : value);437}438 439// R710 signed-digit-string -> [sign] digit-string440// N.B. Not a complete token -- no space is skipped.441// Used only in the exponent parts of real literal constants.442struct SignedDigitString {443 using resultType = std::int64_t;444 static std::optional<std::int64_t> Parse(ParseState &state) {445 std::optional<const char *> sign{state.PeekAtNextChar()};446 if (!sign) {447 return std::nullopt;448 }449 bool negate{**sign == '-'};450 if (negate || **sign == '+') {451 state.UncheckedAdvance();452 }453 return SignedInteger(digitString64.Parse(state), *sign, negate, state);454 }455};456 457// Variants of the above for use in FORMAT specifications, where spaces458// must be ignored.459struct DigitStringIgnoreSpaces {460 using resultType = std::uint64_t;461 static std::optional<std::uint64_t> Parse(ParseState &state) {462 static constexpr auto getFirstDigit{space >> digit};463 std::optional<const char *> firstDigit{getFirstDigit.Parse(state)};464 if (!firstDigit) {465 return std::nullopt;466 }467 std::uint64_t value = **firstDigit - '0';468 bool overflow{false};469 static constexpr auto getDigit{space >> attempt(digit)};470 while (auto nextDigit{getDigit.Parse(state)}) {471 if (value > std::numeric_limits<std::uint64_t>::max() / 10) {472 overflow = true;473 }474 value *= 10;475 int digitValue = **nextDigit - '0';476 if (value > std::numeric_limits<std::uint64_t>::max() - digitValue) {477 overflow = true;478 }479 value += digitValue;480 }481 if (overflow) {482 state.Say(*firstDigit, "overflow in decimal literal"_err_en_US);483 }484 return value;485 }486};487 488struct PositiveDigitStringIgnoreSpaces {489 using resultType = std::int64_t;490 static std::optional<std::int64_t> Parse(ParseState &state) {491 Location at{state.GetLocation()};492 return SignedInteger(493 DigitStringIgnoreSpaces{}.Parse(state), at, false /*positive*/, state);494 }495};496 497struct SignedDigitStringIgnoreSpaces {498 using resultType = std::int64_t;499 static std::optional<std::int64_t> Parse(ParseState &state) {500 static constexpr auto getSign{space >> attempt("+-"_ch)};501 bool negate{false};502 if (std::optional<const char *> sign{getSign.Parse(state)}) {503 negate = **sign == '-';504 }505 Location at{state.GetLocation()};506 return SignedInteger(507 DigitStringIgnoreSpaces{}.Parse(state), at, negate, state);508 }509};510 511// Legacy feature: Hollerith literal constants512struct HollerithLiteral {513 using resultType = std::string;514 static std::optional<std::string> Parse(ParseState &state) {515 space.Parse(state);516 const char *start{state.GetLocation()};517 std::optional<std::uint64_t> charCount{518 DigitStringIgnoreSpaces{}.Parse(state)};519 if (!charCount || *charCount < 1) {520 return std::nullopt;521 }522 static constexpr auto letterH{"h"_ch};523 std::optional<const char *> h{letterH.Parse(state)};524 if (!h) {525 return std::nullopt;526 }527 std::string content;528 for (auto j{*charCount}; j-- > 0;) {529 int chBytes{UTF_8CharacterBytes(state.GetLocation())};530 for (int bytes{chBytes}; bytes > 0; --bytes) {531 if (std::optional<const char *> at{nextCh.Parse(state)}) {532 if (chBytes == 1 && !IsPrintable(**at)) {533 state.Say(start, "Bad character in Hollerith"_err_en_US);534 return std::nullopt;535 }536 content += **at;537 } else {538 state.Say(start, "Insufficient characters in Hollerith"_err_en_US);539 return std::nullopt;540 }541 }542 }543 return content;544 }545};546 547struct ConsumedAllInputParser {548 using resultType = Success;549 constexpr ConsumedAllInputParser() {}550 static inline std::optional<Success> Parse(ParseState &state) {551 if (state.IsAtEnd()) {552 return {Success{}};553 }554 return std::nullopt;555 }556};557constexpr ConsumedAllInputParser consumedAllInput;558 559template <char goal> struct SkipPast {560 using resultType = Success;561 constexpr SkipPast() {}562 constexpr SkipPast(const SkipPast &) {}563 static std::optional<Success> Parse(ParseState &state) {564 while (std::optional<const char *> p{state.GetNextChar()}) {565 if (**p == goal) {566 return {Success{}};567 } else if (**p == '\n') {568 break;569 }570 }571 return std::nullopt;572 }573};574 575template <char goal> struct SkipTo {576 using resultType = Success;577 constexpr SkipTo() {}578 constexpr SkipTo(const SkipTo &) {}579 static std::optional<Success> Parse(ParseState &state) {580 while (std::optional<const char *> p{state.PeekAtNextChar()}) {581 if (**p == goal) {582 return {Success{}};583 } else if (**p == '\n') {584 break;585 } else {586 state.UncheckedAdvance();587 }588 }589 return std::nullopt;590 }591};592 593template <char left, char right> struct SkipPastNested {594 using resultType = Success;595 constexpr SkipPastNested() {}596 constexpr SkipPastNested(const SkipPastNested &) {}597 static std::optional<Success> Parse(ParseState &state) {598 int nesting{1};599 while (std::optional<const char *> p{state.GetNextChar()}) {600 if (**p == right) {601 if (!--nesting) {602 return {Success{}};603 }604 } else if (**p == left) {605 ++nesting;606 } else if (**p == '\n') {607 break;608 }609 }610 return std::nullopt;611 }612};613 614// A common idiom in the Fortran grammar is an optional item (usually615// a nonempty comma-separated list) that, if present, must follow a comma616// and precede a doubled colon. When the item is absent, the comma must617// not appear, and the doubled colons are optional.618// [[, xyz] ::] is optionalBeforeColons(xyz)619// [[, xyz]... ::] is optionalBeforeColons(nonemptyList(xyz))620template <typename PA> inline constexpr auto optionalBeforeColons(const PA &p) {621 using resultType = std::optional<typename PA::resultType>;622 return "," >> construct<resultType>(p) / "::" ||623 ("::"_tok || !","_tok) >> pure<resultType>();624}625template <typename PA>626inline constexpr auto optionalListBeforeColons(const PA &p) {627 using resultType = std::list<typename PA::resultType>;628 return "," >> nonemptyList(p) / "::" ||629 ("::"_tok || !","_tok) >> pure<resultType>();630}631 632// Skip over empty lines, leading spaces, and some compiler directives (viz.,633// the ones that specify the source form) that might appear before the634// next statement. Skip over empty statements (bare semicolons) when635// not in strict standard conformance mode. Always succeeds.636struct SkipStuffBeforeStatement {637 using resultType = Success;638 static std::optional<Success> Parse(ParseState &state) {639 if (UserState * ustate{state.userState()}) {640 if (ParsingLog * log{ustate->log()}) {641 // Save memory: vacate the parsing log before each statement unless642 // we're logging the whole parse for debugging.643 if (!ustate->instrumentedParse()) {644 log->clear();645 }646 }647 }648 while (std::optional<const char *> at{state.PeekAtNextChar()}) {649 if (**at == '\n' || **at == ' ') {650 state.UncheckedAdvance();651 } else if (**at == '!') {652 static const char fixed[] = "!dir$ fixed\n", free[] = "!dir$ free\n";653 static constexpr std::size_t fixedBytes{sizeof fixed - 1};654 static constexpr std::size_t freeBytes{sizeof free - 1};655 std::size_t remain{state.BytesRemaining()};656 if (remain >= fixedBytes && std::memcmp(*at, fixed, fixedBytes) == 0) {657 state.set_inFixedForm(true).UncheckedAdvance(fixedBytes);658 } else if (remain >= freeBytes &&659 std::memcmp(*at, free, freeBytes) == 0) {660 state.set_inFixedForm(false).UncheckedAdvance(freeBytes);661 } else {662 break;663 }664 } else if (**at == ';' &&665 state.IsNonstandardOk(666 LanguageFeature::EmptyStatement, "empty statement"_port_en_US)) {667 state.UncheckedAdvance();668 } else {669 break;670 }671 }672 return {Success{}};673 }674};675constexpr SkipStuffBeforeStatement skipStuffBeforeStatement;676 677// R602 underscore -> _678constexpr auto underscore{"_"_ch};679 680// Characters besides letters and digits that may appear in names.681// N.B. Don't accept an underscore if it is immediately followed by a682// quotation mark, so that kindParam_"character literal" is parsed properly.683// PGI and ifort accept '$' in identifiers, even as the initial character.684// Cray and gfortran accept '$', but not as the first character.685// Cray accepts '@' as well.686constexpr auto otherIdChar{underscore / !"'\""_ch ||687 extension<LanguageFeature::PunctuationInNames>(688 "nonstandard usage: punctuation in name"_port_en_US, "$@"_ch)};689 690constexpr auto logicalTRUE{691 (".TRUE."_tok ||692 extension<LanguageFeature::LogicalAbbreviations>(693 "nonstandard usage: .T. spelling of .TRUE."_port_en_US,694 ".T."_tok)) >>695 pure(true)};696constexpr auto logicalFALSE{697 (".FALSE."_tok ||698 extension<LanguageFeature::LogicalAbbreviations>(699 "nonstandard usage: .F. spelling of .FALSE."_port_en_US,700 ".F."_tok)) >>701 pure(false)};702 703// deprecated: Hollerith literals704constexpr auto rawHollerithLiteral{705 deprecated<LanguageFeature::Hollerith>(HollerithLiteral{})};706 707template <typename A> constexpr decltype(auto) verbatim(A x) {708 return sourced(construct<Verbatim>(x));709}710 711} // namespace Fortran::parser712#endif // FORTRAN_PARSER_TOKEN_PARSERS_H_713