From 0f418c7c8d410796b3862416c02d99d3a86181b7 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Fri, 13 Apr 2018 13:56:49 -0700 Subject: [PATCH] [flang] Simplify proc-component-ref and variable parsing, do not try to support function calls via components of function results. Original-commit: flang-compiler/f18@05886ddb80e31f3caec96cbaba1fea274db7c61a Reviewed-on: https://github.com/flang-compiler/f18/pull/56 Tree-same-pre-rewrite: false --- flang/lib/parser/grammar.h | 161 +++++++++-------------------------------- flang/lib/parser/parse-tree.cc | 120 ------------------------------ flang/lib/parser/parse-tree.h | 19 ++--- flang/lib/parser/unparse.cc | 3 - 4 files changed, 42 insertions(+), 261 deletions(-) diff --git a/flang/lib/parser/grammar.h b/flang/lib/parser/grammar.h index baca3ff..f811544 100644 --- a/flang/lib/parser/grammar.h +++ b/flang/lib/parser/grammar.h @@ -1538,67 +1538,37 @@ TYPE_PARSER(construct{}(name, maybe(arraySpec))) TYPE_PARSER(construct{}(substring) || construct{}(dataReference)) -// R902 variable -> designator | function-reference -// This production is left-recursive in the case of a function reference -// (via procedure-designator -> proc-component-ref -> scalar-variable) -// so it is implemented iteratively here. When a variable is a -// function-reference, the called function must return a pointer in order -// to be valid as a variable, but we can't know that yet here. So we first -// parse a designator, and if it's not a substring, we then allow an -// (actual-arg-spec-list), followed by zero or more "% name (a-a-s-list)". -// -// It is not valid Fortran to immediately invoke the result of a call to -// a function that returns a bare pointer to a function, although that would -// be a reasonable extension. This restriction means that adjacent actual -// argument lists cannot occur (e.g.*, f()()). One must instead return a -// pointer to a derived type instance containing a procedure pointer -// component in order to accomplish roughly the same thing. -// -// Some function references with dummy arguments present will be -// misrecognized as array element designators and need to be corrected -// in semantic analysis. -template<> std::optional Parser::Parse(ParseState *state) { - std::optional desig{designator.Parse(state)}; - if (!desig.has_value()) { +constexpr struct OldStructureComponentName { + using resultType = Name; + static std::optional Parse(ParseState *state) { + if (std::optional n{name.Parse(state)}) { + if (const auto *user = state->userState()) { + if (user->IsOldStructureComponent(n->source)) { + return n; + } + } + } return {}; } - if (!desig->EndsInBareName()) { - return {Variable{Indirection{std::move(desig.value())}}}; - } - static constexpr auto argList = parenthesized(optionalList(actualArgSpec)); - static constexpr auto tryArgList = attempt(argList); - auto args = tryArgList.Parse(state); - if (!args.has_value()) { - return {Variable{Indirection{std::move(desig.value())}}}; - } +} oldStructureComponentName; - // Create a procedure-designator from the original designator and - // combine it with the actual arguments as a function-reference. - ProcedureDesignator pd{desig.value().ConvertToProcedureDesignator()}; - Variable var{Indirection{ - Call{std::move(pd), std::move(args.value())}}}; - - // Repeatedly accept additional function calls through components of - // a derived type result. - struct ResultComponentCall { - ResultComponentCall(ResultComponentCall &&) = default; - ResultComponentCall &operator=(ResultComponentCall &&) = default; - ResultComponentCall(Name &&n, std::list &&as) - : name{std::move(n)}, args(std::move(as)) {} - Name name; - std::list args; - }; - static constexpr auto resultComponentCall = - attempt("%" >> construct{}(name, argList)); - while (auto more = resultComponentCall.Parse(state)) { - var = Variable{Indirection{Call{ - ProcedureDesignator{ProcComponentRef{ - Scalar{std::move(var)}, std::move(more.value().name)}}, - std::move(more.value().args)}}}; - } +constexpr auto percentOrDot = "%"_tok || + // legacy VAX extension for RECORD field access + extension("."_tok / lookAhead(oldStructureComponentName)); - return {std::move(var)}; -} +// R902 variable -> designator | function-reference +// This production appears to be left-recursive in the grammar via +// function-reference -> procedure-designator -> proc-component-ref -> +// scalar-variable +// and would be so if we were to allow functions to be called via procedure +// pointer components within derived type results of other function references +// (a reasonable extension, esp. in the case of procedure pointer components +// that are NOPASS). However, Fortran constrains the use of a variable in a +// proc-component-ref to be a data-ref without coindices (C1027). +// Some array element references will be misrecognized as function references. +TYPE_PARSER(construct{}( + indirect(functionReference / !"("_ch) / !percentOrDot) || + construct{}(indirect(designator))) // R904 logical-variable -> variable // Appears only as part of scalar-logical-variable. @@ -1642,24 +1612,6 @@ TYPE_PARSER(space >> "."_ch >> // R911 data-ref -> part-ref [% part-ref]... // R914 coindexed-named-object -> data-ref // R917 array-element -> data-ref -constexpr struct StructureComponentName { - using resultType = Name; - static std::optional Parse(ParseState *state) { - if (std::optional n{name.Parse(state)}) { - if (const auto *user = state->userState()) { - if (user->IsOldStructureComponent(n->source)) { - return n; - } - } - } - return {}; - } -} structureComponentName; - -constexpr auto percentOrDot = "%"_tok || - // legacy VAX extension for RECORD field access - extension("."_tok / lookAhead(structureComponentName)); - TYPE_PARSER(construct{}( nonemptySeparated(Parser{}, percentOrDot))) @@ -2128,8 +2080,8 @@ TYPE_PARSER(construct{}(boundExpr / ":")) TYPE_PARSER(construct{}(boundExpr / ":", boundExpr)) // R1039 proc-component-ref -> scalar-variable % procedure-component-name -// N.B. Never parsed as such; instead, reconstructed as necessary from -// parses of variable. +// C1027 constrains the scalar-variable to be a data-ref without coindices. +TYPE_PARSER(construct{}(structureComponent)) // R1041 where-stmt -> WHERE ( mask-expr ) where-assignment-stmt // R1045 where-assignment-stmt -> assignment-stmt @@ -3445,59 +3397,18 @@ TYPE_PARSER("INTRINSIC" >> maybe("::"_tok) >> construct{}(nonemptyList(name))) // R1520 function-reference -> procedure-designator ( [actual-arg-spec-list] ) -// Without recourse to a symbol table, a parse of the production for -// variable as part of a procedure-designator will overshoot and consume -// any actual argument list, since a pointer-valued function-reference is -// acceptable as an alternative for a variable (since Fortran 2008). -template<> -std::optional Parser::Parse( - ParseState *state) { - state->PushContext("function reference"_en_US); - std::optional var{variable.Parse(state)}; - if (var.has_value()) { - if (auto funcref = std::get_if>(&var->u)) { - // The parsed variable is a function-reference, so just return it. - state->PopContext(); - return {std::move(**funcref)}; - } - Designator *desig{&*std::get>(var->u)}; - if (std::optional call{desig->ConvertToCall(state->userState())}) { - if (!std::get>(call.value().t).empty()) { - // Parsed a designator that ended with a nonempty list of subscripts - // that have all been converted to actual arguments. - state->PopContext(); - return {FunctionReference{std::move(call.value())}}; - } - } - state->Say("expected (arguments)"_err_en_US); - } - state->PopContext(); - return {}; -} +TYPE_PARSER(construct{}(construct{}( + Parser{}, parenthesized(optionalList(actualArgSpec))))) // R1521 call-stmt -> CALL procedure-designator [( [actual-arg-spec-list] )] -template<> std::optional Parser::Parse(ParseState *state) { - static constexpr auto parser = - inContext("CALL statement"_en_US, "CALL" >> variable); - std::optional var{parser.Parse(state)}; - if (var.has_value()) { - if (auto funcref = std::get_if>(&var->u)) { - state->PopContext(); - return {CallStmt{std::move((*funcref)->v)}}; - } - Designator *desig{&*std::get>(var->u)}; - if (std::optional call{desig->ConvertToCall(state->userState())}) { - return {CallStmt{std::move(call.value())}}; - } - } - return {}; -} +TYPE_PARSER(construct{}( + construct{}("CALL" >> Parser{}, + defaulted(parenthesized(optionalList(actualArgSpec)))))) // R1522 procedure-designator -> // procedure-name | proc-component-ref | data-ref % binding-name -// N.B. Not implemented as an independent production; instead, instances -// of procedure-designator must be reconstructed from portions of parses of -// variable. +TYPE_PARSER(construct{}(Parser{}) || + construct{}(name)) // R1523 actual-arg-spec -> [keyword =] actual-arg TYPE_PARSER( diff --git a/flang/lib/parser/parse-tree.cc b/flang/lib/parser/parse-tree.cc index ee402fe..ab88549 100644 --- a/flang/lib/parser/parse-tree.cc +++ b/flang/lib/parser/parse-tree.cc @@ -25,86 +25,6 @@ bool Designator::EndsInBareName() const { u); } -ProcedureDesignator Designator::ConvertToProcedureDesignator() { - return std::visit( - visitors{ - [](ObjectName &n) -> ProcedureDesignator { return {std::move(n)}; }, - [](DataReference &dr) -> ProcedureDesignator { - if (auto n = std::get_if(&dr.u)) { - return {std::move(*n)}; - } - StructureComponent &sc{ - *std::get>(dr.u)}; - return {ProcComponentRef{ - Scalar{Indirection{std::move(sc.base)}}, - std::move(sc.component)}}; - }, - [](Substring &) -> ProcedureDesignator { - CHECK(!"can't get here"); - return {Name{}}; - }}, - u); -} - -std::optional Designator::ConvertToCall(const UserState *ustate) { - return std::visit( - visitors{[](ObjectName &n) -> std::optional { - return {Call{ProcedureDesignator{std::move(n)}, - std::list{}}}; - }, - [=](DataReference &dr) -> std::optional { - if (std::holds_alternative>( - dr.u)) { - return {}; - } - if (Name * n{std::get_if(&dr.u)}) { - return {Call{ProcedureDesignator{std::move(*n)}, - std::list{}}}; - } - if (auto *isc = - std::get_if>(&dr.u)) { - StructureComponent &sc{**isc}; - if (ustate && - ustate->IsOldStructureComponent(sc.component.source)) { - return {}; - } - Variable var{Indirection{std::move(sc.base)}}; - ProcComponentRef pcr{ - Scalar{std::move(var)}, std::move(sc.component)}; - return {Call{ProcedureDesignator{std::move(pcr)}, - std::list{}}}; - } - ArrayElement &ae{*std::get>(dr.u)}; - if (std::any_of(ae.subscripts.begin(), ae.subscripts.end(), - [](const SectionSubscript &ss) { - return !ss.CanConvertToActualArgument(); - })) { - return {}; - } - std::list args; - for (auto &ss : ae.subscripts) { - args.emplace_back( - std::optional{}, ss.ConvertToActualArgument()); - } - if (Name * n{std::get_if(&ae.base.u)}) { - return { - Call{ProcedureDesignator{std::move(*n)}, std::move(args)}}; - } - StructureComponent &bsc{ - *std::get>(ae.base.u)}; - if (ustate && - ustate->IsOldStructureComponent(bsc.component.source)) { - return {}; - } - Variable var{Indirection{std::move(bsc.base)}}; - ProcComponentRef pcr{ - Scalar{std::move(var)}, std::move(bsc.component)}; - return {Call{ProcedureDesignator{std::move(pcr)}, std::move(args)}}; - }, - [](const Substring &) -> std::optional { return {}; }}, - u); -} - // R911 data-ref -> part-ref [% part-ref]... DataReference::DataReference(std::list &&prl) : u{std::move(prl.front().name)} { @@ -123,49 +43,9 @@ DataReference::DataReference(std::list &&prl) } } -// R920 section-subscript -bool SectionSubscript::CanConvertToActualArgument() const { - return std::visit(visitors{[](const VectorSubscript &) { return true; }, - [](const ScalarIntExpr &) { return true; }, - [](const SubscriptTriplet &) { return false; }}, - u); -} - -ActualArg SectionSubscript::ConvertToActualArgument() { - return std::visit(visitors{[](VectorSubscript &vs) -> ActualArg { - return vs.thing->ConvertToActualArgument(); - }, - [](ScalarIntExpr &vs) -> ActualArg { - return vs.thing.thing->ConvertToActualArgument(); - }, - [](SubscriptTriplet &) -> ActualArg { - CHECK(!"can't happen"); - return {Name{}}; - }}, - u); -} - // R1001 - R1022 expression Expr::Expr(Designator &&x) : u{Indirection(std::move(x))} {} Expr::Expr(FunctionReference &&x) : u{Indirection(std::move(x))} {} - -std::optional Expr::ConvertToVariable() { - if (Indirection *id = std::get_if>(&u)) { - return {Variable{std::move(*id)}}; - } - if (Indirection *ifr = - std::get_if>(&u)) { - return {Variable{std::move(*ifr)}}; - } - return {}; -} - -ActualArg Expr::ConvertToActualArgument() { - if (std::optional var{ConvertToVariable()}) { - return {std::move(var.value())}; - } - return {std::move(*this)}; -} } // namespace parser } // namespace Fortran diff --git a/flang/lib/parser/parse-tree.h b/flang/lib/parser/parse-tree.h index 06bd19e..df32d23 100644 --- a/flang/lib/parser/parse-tree.h +++ b/flang/lib/parser/parse-tree.h @@ -1536,8 +1536,6 @@ using VectorSubscript = IntExpr; // R920 section-subscript -> subscript | subscript-triplet | vector-subscript struct SectionSubscript { UNION_CLASS_BOILERPLATE(SectionSubscript); - bool CanConvertToActualArgument() const; - ActualArg ConvertToActualArgument(); std::variant u; }; @@ -1659,9 +1657,6 @@ struct Expr { explicit Expr(Designator &&); explicit Expr(FunctionReference &&); - std::optional ConvertToVariable(); - ActualArg ConvertToActualArgument(); - std::variant, LiteralConstant, Indirection, ArrayConstructor, StructureConstructor, Indirection, Indirection, @@ -1716,8 +1711,6 @@ struct CharLiteralConstantSubstring { struct Designator { UNION_CLASS_BOILERPLATE(Designator); bool EndsInBareName() const; - ProcedureDesignator ConvertToProcedureDesignator(); - std::optional ConvertToCall(const UserState *ustate = nullptr); std::variant u; }; @@ -1742,12 +1735,6 @@ using ScalarDefaultCharVariable = Scalar>; // Appears only as part of scalar-int-variable. using ScalarIntVariable = Scalar>; -// R1039 proc-component-ref -> scalar-variable % procedure-component-name -struct ProcComponentRef { - TUPLE_CLASS_BOILERPLATE(ProcComponentRef); - std::tuple, Name> t; -}; - // R913 structure-component -> data-ref struct StructureComponent { BOILERPLATE(StructureComponent); @@ -1757,6 +1744,12 @@ struct StructureComponent { Name component; }; +// R1039 proc-component-ref -> scalar-variable % procedure-component-name +// C1027 constrains the scalar-variable to be a data-ref without coindices. +struct ProcComponentRef { + WRAPPER_CLASS_BOILERPLATE(ProcComponentRef, Scalar); +}; + // R914 coindexed-named-object -> data-ref struct CoindexedNamedObject { BOILERPLATE(CoindexedNamedObject); diff --git a/flang/lib/parser/unparse.cc b/flang/lib/parser/unparse.cc index c5a0fe2..3699f58 100644 --- a/flang/lib/parser/unparse.cc +++ b/flang/lib/parser/unparse.cc @@ -803,9 +803,6 @@ public: void Unparse(const BoundsRemapping &x) { // R1036 Walk(x.t, ":"); } - void Unparse(const ProcComponentRef &x) { // R1039 - Walk(std::get>(x.t)), Put('%'), Walk(std::get(x.t)); - } void Unparse(const WhereStmt &x) { // R1041, R1045, R1046 Word("WHERE ("), Walk(x.t, ") "); } -- 2.7.4