From a62636f63452f956eb658dc04ea62c12a56776d3 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Mon, 8 Oct 2018 15:35:19 -0700 Subject: [PATCH] [flang] debug initial intrinsic table probes Original-commit: flang-compiler/f18@dce9a1e1734f6bbc4aff110ac943649f7dcc066a Reviewed-on: https://github.com/flang-compiler/f18/pull/212 Tree-same-pre-rewrite: false --- flang/lib/common/bit-population-count.h | 2 +- flang/lib/evaluate/CMakeLists.txt | 1 + flang/lib/evaluate/call.cc | 35 ++++++++ flang/lib/evaluate/call.h | 46 ++++++++++ flang/lib/evaluate/common.h | 4 + flang/lib/evaluate/expression.cc | 36 +++++++- flang/lib/evaluate/expression.h | 50 ++++++++--- flang/lib/evaluate/intrinsics.cc | 114 +++++++++++++------------ flang/lib/evaluate/intrinsics.h | 29 ++----- flang/lib/evaluate/type.cc | 33 ++++++++ flang/lib/evaluate/type.h | 28 ++++++ flang/lib/evaluate/variable.cc | 15 ---- flang/lib/evaluate/variable.h | 63 +++++++------- flang/lib/semantics/expression.cc | 146 ++++++++++++++++---------------- flang/lib/semantics/expression.h | 15 +--- flang/tools/f18/f18.cc | 7 +- 16 files changed, 398 insertions(+), 226 deletions(-) create mode 100644 flang/lib/evaluate/call.cc create mode 100644 flang/lib/evaluate/call.h diff --git a/flang/lib/common/bit-population-count.h b/flang/lib/common/bit-population-count.h index b4282c9..ba00b1b 100644 --- a/flang/lib/common/bit-population-count.h +++ b/flang/lib/common/bit-population-count.h @@ -83,7 +83,7 @@ template inline constexpr bool Parity(UINT x) { // "Parity is for farmers." -- Seymour R. Cray template inline constexpr int TrailingZeroCount(UINT x) { - return BitPopulationCount(x ^ (x - 1)) - !x; + return BitPopulationCount(x ^ (x - 1)) - !!x; } } // namespace Fortran::common #endif // FORTRAN_COMMON_BIT_POPULATION_COUNT_H_ diff --git a/flang/lib/evaluate/CMakeLists.txt b/flang/lib/evaluate/CMakeLists.txt index c03e3cd..a98c921 100644 --- a/flang/lib/evaluate/CMakeLists.txt +++ b/flang/lib/evaluate/CMakeLists.txt @@ -13,6 +13,7 @@ # limitations under the License. add_library(FortranEvaluate + call.cc common.cc complex.cc expression.cc diff --git a/flang/lib/evaluate/call.cc b/flang/lib/evaluate/call.cc new file mode 100644 index 0000000..359790a --- /dev/null +++ b/flang/lib/evaluate/call.cc @@ -0,0 +1,35 @@ +// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +#include "call.h" +#include "expression.h" + +namespace Fortran::evaluate { + +std::optional ActualArgument::GetType() const { + return value->GetType(); +} + +int ActualArgument::Rank() const { return value->Rank(); } + +std::ostream &ActualArgument::Dump(std::ostream &o) const { + if (keyword.has_value()) { + o << keyword->ToString() << '='; + } + if (isAlternateReturn) { + o << '*'; + } + return value->Dump(o); +} +} // namespace Fortran::evaluate diff --git a/flang/lib/evaluate/call.h b/flang/lib/evaluate/call.h new file mode 100644 index 0000000..b31156b --- /dev/null +++ b/flang/lib/evaluate/call.h @@ -0,0 +1,46 @@ +// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +#ifndef FORTRAN_EVALUATE_CALL_H_ +#define FORTRAN_EVALUATE_CALL_H_ + +#include "common.h" +#include "type.h" +#include "../common/indirection.h" +#include "../parser/char-block.h" +#include +#include +#include + +namespace Fortran::evaluate { + +struct ActualArgument { + explicit ActualArgument(CopyableIndirection> &&v) + : value{std::move(v)} {} + std::optional GetType() const; + int Rank() const; + std::ostream &Dump(std::ostream &) const; + + std::optional keyword; + bool isAssumedRank{false}; + bool isAlternateReturn{false}; + std::optional vectorSize; // TODO: pmk replace with function on value + std::optional intValue; // TODO: pmk replace with function on value + CopyableIndirection> value; +}; + +using Arguments = std::vector; + +} // namespace Fortran::evaluate +#endif // FORTRAN_EVALUATE_CALL_H_ diff --git a/flang/lib/evaluate/common.h b/flang/lib/evaluate/common.h index 4bec50d..ffdbe98 100644 --- a/flang/lib/evaluate/common.h +++ b/flang/lib/evaluate/common.h @@ -138,6 +138,10 @@ using HostUnsignedInt = // Force availability of copy construction and assignment template using CopyableIndirection = common::Indirection; +// Forward definition of Expr<> so that it can be indirectly used in its own +// definition +template class Expr; + // Classes that support a Fold(FoldingContext &) member function have the // IsFoldableTrait. CLASS_TRAIT(IsFoldableTrait) diff --git a/flang/lib/evaluate/expression.cc b/flang/lib/evaluate/expression.cc index 51dffed..515bd9d 100644 --- a/flang/lib/evaluate/expression.cc +++ b/flang/lib/evaluate/expression.cc @@ -472,6 +472,11 @@ std::ostream &ExpressionBase::Dump(std::ostream &o) const { return o; } +std::ostream &Expr::Dump(std::ostream &o) const { + std::visit([&](const auto &x) { x.Dump(o); }, u); + return o; +} + template Expr Expr>::LEN() const { return std::visit( @@ -534,7 +539,32 @@ auto ExpressionBase::ScalarValue() const Expr::~Expr() {} -// Rank() +template +std::optional ExpressionBase::GetType() const { + if constexpr (Result::isSpecificType) { + if constexpr (Result::category == TypeCategory::Derived) { + return std::visit([](const auto &x) { return x.GetType(); }, derived().u); + } else { + return Result::GetType(); + } + } else { + return std::visit( + [](const auto &x) -> std::optional { + if constexpr (std::is_same_v, + BOZLiteralConstant>) { + return std::nullopt; // typeless -> no type + } else { + return x.GetType(); + } + }, + derived().u); + } +} + +std::optional Expr::GetType() const { + return std::visit([](const auto &x) { return x.GetType(); }, u); +} + template int ExpressionBase::Rank() const { return std::visit( [](const auto &x) { @@ -548,6 +578,10 @@ template int ExpressionBase::Rank() const { derived().u); } +int Expr::Rank() const { + return std::visit([](const auto &x) { return x.Rank(); }, u); +} + // Template instantiations to resolve the "extern template" declarations // that appear in expression.h. diff --git a/flang/lib/evaluate/expression.h b/flang/lib/evaluate/expression.h index dab8bf0..8b3ff0e 100644 --- a/flang/lib/evaluate/expression.h +++ b/flang/lib/evaluate/expression.h @@ -45,12 +45,23 @@ using common::RelationalOperator; // can be valid expressions in that context: // - Expr> represents an expression whose result is of a // specific intrinsic type category and kind, e.g. Type +// - Expr wraps data and procedure references that result in an +// instance of a derived type // - Expr> is a union of Expr> for each // kind type parameter value K in that intrinsic type category. It represents // an expression with known category and any kind. // - Expr is a union of Expr> over the five // intrinsic type categories of Fortran. It represents any valid expression. -template class Expr; +// +// Every Expr specialization supports at least these interfaces: +// using Result = ...; // type of a result of this expression +// using IsFoldableTrait = ...; +// DynamicType GetType() const; +// int Rank() const; +// std::ostream &Dump(std::ostream &) const; +// // If IsFoldableTrait::value is true, then these exist: +// std::optional> Fold(FoldingContext &c); +// std::optional> ScalarValue() const; // Everything that can appear in, or as, a valid Fortran expression must be // represented with an instance of some class containing a Result typedef that @@ -67,6 +78,13 @@ template struct Constant { template Constant(std::enable_if_t, A> &&x) : value(std::move(x)) {} + constexpr std::optional GetType() const { + if constexpr (Result::isSpecificType) { + return Result::GetType(); + } else { + return value.GetType(); + } + } int Rank() const { return 0; } std::ostream &Dump(std::ostream &) const; Value value; @@ -89,7 +107,6 @@ using BOZLiteralConstant = typename LargestReal::Scalar::Word; // from it via its derived() member function with compile-time type safety. template class Operation { - static_assert(RESULT::isSpecificType); // The extra "int" member is a dummy that allows a safe unused reference // to element 1 to arise indirectly in the definition of "right()" below // when the operation has but a single operand. @@ -98,6 +115,8 @@ class Operation { public: using Derived = DERIVED; using Result = RESULT; + static_assert(Result::isSpecificType); + static_assert(Result::category != TypeCategory::Derived); static constexpr std::size_t operands{sizeof...(OPERANDS)}; template using Operand = std::tuple_element_t; using IsFoldableTrait = std::true_type; @@ -155,6 +174,9 @@ public: } } + static constexpr std::optional GetType() { + return Result::GetType(); + } int Rank() const { int rank{left().Rank()}; if constexpr (operands > 1) { @@ -416,6 +438,7 @@ template struct ExpressionBase { return d; } + std::optional GetType() const; int Rank() const; std::ostream &Dump(std::ostream &) const; std::optional> Fold(FoldingContext &c); @@ -554,6 +577,9 @@ template<> class Relational { public: using Result = LogicalResult; EVALUATE_UNION_CLASS_BOILERPLATE(Relational) + static constexpr std::optional GetType() { + return Result::GetType(); + } int Rank() const { return std::visit([](const auto &x) { return x.Rank(); }, u); } @@ -601,20 +627,19 @@ public: common::MapTemplate> u; }; -template<> class Expr : public ExpressionBase { +// Note that Expr does not inherit from ExpressionBase +// since Constant and Scalar are not defined +// for derived types.. +template<> class Expr { public: using Result = SomeDerived; using IsFoldableTrait = std::false_type; - CLASS_BOILERPLATE(Expr) + EVALUATE_UNION_CLASS_BOILERPLATE(Expr) - template - explicit Expr(const semantics::DerivedTypeSpec &dts, const A &x) - : result{dts}, u{x} {} - template - explicit Expr(Result &&r, std::enable_if_t, A> &&x) - : result{std::move(r)}, u{std::move(x)} {} + std::optional GetType() const; + int Rank() const; + std::ostream &Dump(std::ostream &) const; - Result result; std::variant, FunctionRef> u; }; @@ -667,8 +692,7 @@ struct GenericExprWrapper { }; FOR_EACH_CATEGORY_TYPE(extern template class Expr) -FOR_EACH_INTRINSIC_KIND(extern template struct ExpressionBase) -FOR_EACH_CATEGORY_TYPE(extern template struct ExpressionBase) +FOR_EACH_TYPE_AND_KIND(extern template struct ExpressionBase) } // namespace Fortran::evaluate #endif // FORTRAN_EVALUATE_EXPRESSION_H_ diff --git a/flang/lib/evaluate/intrinsics.cc b/flang/lib/evaluate/intrinsics.cc index 93ce8bf..89de6e5 100644 --- a/flang/lib/evaluate/intrinsics.cc +++ b/flang/lib/evaluate/intrinsics.cc @@ -13,11 +13,11 @@ // limitations under the License. #include "intrinsics.h" +#include "expression.h" #include "type.h" #include "../common/enum-set.h" #include "../common/fortran.h" #include "../common/idioms.h" -#include "../semantics/expression.h" #include #include #include @@ -186,7 +186,7 @@ struct IntrinsicInterface { TypePattern result; Rank rank{Rank::elemental}; std::optional Match(const CallCharacteristics &, - const semantics::IntrinsicTypeDefaultKinds &, + const IntrinsicTypeDefaultKinds &, parser::ContextualMessages &messages) const; }; @@ -528,19 +528,24 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{ // Intrinsic interface matching against the arguments of a particular // procedure reference. std::optional IntrinsicInterface::Match( - const CallCharacteristics &call, - const semantics::IntrinsicTypeDefaultKinds &defaults, + const CallCharacteristics &call, const IntrinsicTypeDefaultKinds &defaults, parser::ContextualMessages &messages) const { // Attempt to construct a 1-1 correspondence between the dummy arguments in // a particular intrinsic procedure's generic interface and the actual // arguments in a procedure reference. - const ActualArgumentCharacteristics *actualForDummy[maxArguments]; + const ActualArgument *actualForDummy[maxArguments]; int dummies{0}; for (; dummies < maxArguments && dummy[dummies].keyword != nullptr; ++dummies) { actualForDummy[dummies] = nullptr; } - for (const ActualArgumentCharacteristics &arg : call.argument) { + for (const ActualArgument &arg : call.argument) { + if (arg.isAlternateReturn) { + messages.Say( + "alternate return specifier not acceptable on call to intrinsic '%s'"_err_en_US, + call.name.ToString().data()); + return std::nullopt; + } bool found{false}; for (int dummyArgIndex{0}; dummyArgIndex < dummies; ++dummyArgIndex) { if (actualForDummy[dummyArgIndex] == nullptr) { @@ -567,9 +572,9 @@ std::optional IntrinsicInterface::Match( // Check types and kinds of the actual arguments against the intrinsic's // interface. Ensure that two or more arguments that have to have the same // type and kind do so. Check for missing non-optional arguments now, too. - const ActualArgumentCharacteristics *sameArg{nullptr}; + const ActualArgument *sameArg{nullptr}; const IntrinsicDummyArgument *kindDummyArg{nullptr}; - const ActualArgumentCharacteristics *kindArg{nullptr}; + const ActualArgument *kindArg{nullptr}; bool hasDimArg{false}; for (int dummyArgIndex{0}; dummyArgIndex < dummies; ++dummyArgIndex) { const IntrinsicDummyArgument &d{dummy[dummyArgIndex]}; @@ -577,7 +582,7 @@ std::optional IntrinsicInterface::Match( CHECK(kindDummyArg == nullptr); kindDummyArg = &d; } - const ActualArgumentCharacteristics *arg{actualForDummy[dummyArgIndex]}; + const ActualArgument *arg{actualForDummy[dummyArgIndex]}; if (!arg) { if (d.optionality == Optionality::required) { messages.Say("missing '%s' argument"_err_en_US, d.keyword); @@ -586,17 +591,18 @@ std::optional IntrinsicInterface::Match( continue; } } - if (arg->isBOZ) { - CHECK(arg->rank == 0); + std::optional type{arg->GetType()}; + if (!type.has_value()) { + CHECK(arg->Rank() == 0); if (d.typePattern.kindCode == KindCode::typeless || d.rank == Rank::elementalOrBOZ) { continue; } messages.Say("typeless (BOZ) not allowed for '%s'"_err_en_US, d.keyword); return std::nullopt; - } else if (!d.typePattern.categorySet.test(arg->type.category)) { + } else if (!d.typePattern.categorySet.test(type->category)) { messages.Say("actual argument for '%s' has bad type '%s'"_err_en_US, - d.keyword, arg->type.Dump().data()); + d.keyword, type->Dump().data()); return std::nullopt; // argument has invalid type category } bool argOk{false}; @@ -607,19 +613,19 @@ std::optional IntrinsicInterface::Match( argOk = false; break; case KindCode::defaultIntegerKind: - argOk = arg->type.kind == defaults.defaultIntegerKind; + argOk = type->kind == defaults.defaultIntegerKind; break; case KindCode::defaultRealKind: - argOk = arg->type.kind == defaults.defaultRealKind; + argOk = type->kind == defaults.defaultRealKind; break; case KindCode::doublePrecision: - argOk = arg->type.kind == defaults.defaultDoublePrecisionKind; + argOk = type->kind == defaults.defaultDoublePrecisionKind; break; case KindCode::defaultCharKind: - argOk = arg->type.kind == defaults.defaultCharacterKind; + argOk = type->kind == defaults.defaultCharacterKind; break; case KindCode::defaultLogicalKind: - argOk = arg->type.kind == defaults.defaultLogicalKind; + argOk = type->kind == defaults.defaultLogicalKind; break; case KindCode::any: argOk = true; break; case KindCode::kindArg: @@ -635,7 +641,7 @@ std::optional IntrinsicInterface::Match( if (sameArg == nullptr) { sameArg = arg; } - argOk = arg->type == sameArg->type; + argOk = *type == sameArg->GetType(); break; case KindCode::effectiveKind: common::die("INTERNAL: KindCode::effectiveKind appears on argument '%s' " @@ -647,49 +653,49 @@ std::optional IntrinsicInterface::Match( if (!argOk) { messages.Say( "actual argument for '%s' has bad type or kind '%s'"_err_en_US, - d.keyword, arg->type.Dump().data()); + d.keyword, type->Dump().data()); return std::nullopt; } } // Check the ranks of the arguments against the intrinsic's interface. - const ActualArgumentCharacteristics *arrayArg{nullptr}; - const ActualArgumentCharacteristics *knownArg{nullptr}; - const ActualArgumentCharacteristics *shapeArg{nullptr}; + const ActualArgument *arrayArg{nullptr}; + const ActualArgument *knownArg{nullptr}; + const ActualArgument *shapeArg{nullptr}; int elementalRank{0}; for (int dummyArgIndex{0}; dummyArgIndex < dummies; ++dummyArgIndex) { const IntrinsicDummyArgument &d{dummy[dummyArgIndex]}; - if (const ActualArgumentCharacteristics * - arg{actualForDummy[dummyArgIndex]}) { + if (const ActualArgument * arg{actualForDummy[dummyArgIndex]}) { if (arg->isAssumedRank && d.rank != Rank::anyOrAssumedRank) { messages.Say( "assumed-rank array cannot be used for '%s' argument"_err_en_US, d.keyword); return std::nullopt; } + int rank{arg->Rank()}; bool argOk{false}; switch (d.rank) { case Rank::elemental: case Rank::elementalOrBOZ: if (elementalRank == 0) { - elementalRank = arg->rank; + elementalRank = rank; } - argOk = arg->rank == 0 || arg->rank == elementalRank; + argOk = rank == 0 || rank == elementalRank; break; - case Rank::scalar: argOk = arg->rank == 0; break; - case Rank::vector: argOk = arg->rank == 1; break; + case Rank::scalar: argOk = rank == 0; break; + case Rank::vector: argOk = rank == 1; break; case Rank::shape: CHECK(shapeArg == nullptr); shapeArg = arg; - argOk = arg->rank == 1 && arg->vectorSize.has_value(); + argOk = rank == 1 && arg->vectorSize.has_value(); break; - case Rank::matrix: argOk = arg->rank == 2; break; + case Rank::matrix: argOk = rank == 2; break; case Rank::array: - argOk = arg->rank > 0; + argOk = rank > 0; if (!arrayArg) { arrayArg = arg; } else { - argOk &= arg->rank == arrayArg->rank; + argOk &= rank == arrayArg->Rank(); } break; case Rank::known: @@ -700,14 +706,14 @@ std::optional IntrinsicInterface::Match( case Rank::anyOrAssumedRank: argOk = true; break; case Rank::conformable: CHECK(arrayArg != nullptr); - argOk = arg->rank == 0 || arg->rank == arrayArg->rank; + argOk = rank == 0 || rank == arrayArg->Rank(); break; case Rank::dimRemoved: CHECK(arrayArg != nullptr); if (hasDimArg) { - argOk = arg->rank + 1 == arrayArg->rank; + argOk = rank + 1 == arrayArg->Rank(); } else { - argOk = arg->rank == 0; + argOk = rank == 0; } break; case Rank::dimReduced: @@ -720,7 +726,7 @@ std::optional IntrinsicInterface::Match( } if (!argOk) { messages.Say("'%s' argument has unacceptable rank %d"_err_en_US, - d.keyword, arg->rank); + d.keyword, rank); return std::nullopt; } } @@ -762,8 +768,8 @@ std::optional IntrinsicInterface::Match( break; case KindCode::same: CHECK(sameArg != nullptr); - CHECK(result.categorySet.test(sameArg->type.category)); - resultType = sameArg->type; + resultType = *sameArg->GetType(); + CHECK(result.categorySet.test(resultType.category)); break; case KindCode::effectiveKind: CHECK(kindDummyArg != nullptr); @@ -771,10 +777,10 @@ std::optional IntrinsicInterface::Match( if (kindArg != nullptr) { CHECK(kindArg->intValue.has_value()); resultType.kind = *kindArg->intValue; - // TODO pmk: validate the kind!! + // TODO pmk: validate this kind!! } else if (kindDummyArg->optionality == Optionality::defaultsToSameKind) { CHECK(sameArg != nullptr); - resultType = sameArg->type; + resultType = *sameArg->GetType(); } else { CHECK( kindDummyArg->optionality == Optionality::defaultsToDefaultForResult); @@ -801,11 +807,11 @@ std::optional IntrinsicInterface::Match( case Rank::matrix: resultRank = 2; break; case Rank::dimReduced: CHECK(arrayArg != nullptr); - resultRank = hasDimArg ? arrayArg->rank - 1 : 0; + resultRank = hasDimArg ? arrayArg->Rank() - 1 : 0; break; case Rank::rankPlus1: CHECK(knownArg != nullptr); - resultRank = knownArg->rank + 1; + resultRank = knownArg->Rank() + 1; break; case Rank::shaped: CHECK(shapeArg != nullptr); @@ -829,8 +835,8 @@ std::optional IntrinsicInterface::Match( name, elementalRank > 0, resultType, resultRank); } -struct IntrinsicTable::Implementation { - explicit Implementation(const semantics::IntrinsicTypeDefaultKinds &dfts) +struct IntrinsicProcTable::Implementation { + explicit Implementation(const IntrinsicTypeDefaultKinds &dfts) : defaults{dfts} { for (const IntrinsicInterface &f : genericIntrinsicFunction) { genericFuncs.insert(std::make_pair(std::string{f.name}, &f)); @@ -843,14 +849,14 @@ struct IntrinsicTable::Implementation { std::optional Probe( const CallCharacteristics &, parser::ContextualMessages *) const; - semantics::IntrinsicTypeDefaultKinds defaults; + IntrinsicTypeDefaultKinds defaults; std::multimap genericFuncs; std::multimap specificFuncs; }; // Probe the configured intrinsic procedure pattern tables in search of a // match for a given procedure reference. -std::optional IntrinsicTable::Implementation::Probe( +std::optional IntrinsicProcTable::Implementation::Probe( const CallCharacteristics &call, parser::ContextualMessages *messages) const { if (call.isSubroutineCall) { @@ -885,23 +891,23 @@ std::optional IntrinsicTable::Implementation::Probe( return std::nullopt; } -IntrinsicTable::~IntrinsicTable() { +IntrinsicProcTable::~IntrinsicProcTable() { // Discard the configured tables. delete impl_; impl_ = nullptr; } -IntrinsicTable IntrinsicTable::Configure( - const semantics::IntrinsicTypeDefaultKinds &defaults) { - IntrinsicTable result; - result.impl_ = new IntrinsicTable::Implementation(defaults); +IntrinsicProcTable IntrinsicProcTable::Configure( + const IntrinsicTypeDefaultKinds &defaults) { + IntrinsicProcTable result; + result.impl_ = new IntrinsicProcTable::Implementation(defaults); return result; } -std::optional IntrinsicTable::Probe( +std::optional IntrinsicProcTable::Probe( const CallCharacteristics &call, parser::ContextualMessages *messages) const { - CHECK(impl_ != nullptr || !"IntrinsicTable: not configured"); + CHECK(impl_ != nullptr || !"IntrinsicProcTable: not configured"); return impl_->Probe(call, messages); } } // namespace Fortran::evaluate diff --git a/flang/lib/evaluate/intrinsics.h b/flang/lib/evaluate/intrinsics.h index f553963..77d7c7f 100644 --- a/flang/lib/evaluate/intrinsics.h +++ b/flang/lib/evaluate/intrinsics.h @@ -15,6 +15,7 @@ #ifndef FORTRAN_EVALUATE_INTRINSICS_H_ #define FORTRAN_EVALUATE_INTRINSICS_H_ +#include "call.h" #include "type.h" #include "../common/idioms.h" #include "../parser/char-block.h" @@ -23,50 +24,34 @@ #include #include -namespace Fortran::semantics { -struct IntrinsicTypeDefaultKinds; -} - namespace Fortran::evaluate { // Placeholder ENUM_CLASS(IntrinsicProcedure, IAND, IEOR, IOR, LEN, MAX, MIN) -// Characterize an actual argument to an intrinsic procedure reference -struct ActualArgumentCharacteristics { - std::optional keyword; - bool isBOZ{false}; - bool isAssumedRank{false}; - DynamicType type; - int rank; - std::optional vectorSize; - std::optional intValue; -}; - struct CallCharacteristics { - bool isSubroutineCall{false}; parser::CharBlock name; - std::vector argument; + const std::vector &argument; + bool isSubroutineCall{false}; }; struct SpecificIntrinsic { - // SpecificIntrinsic(SpecificIntrinsic &&) = default; explicit SpecificIntrinsic(const char *n) : name{n} {} SpecificIntrinsic(const char *n, bool isElem, DynamicType dt, int r) : name{n}, isElemental{isElem}, type{dt}, rank{r} {} - const char *name; // not owned + const char *name; // not owner bool isElemental{false}; DynamicType type; int rank{0}; }; -class IntrinsicTable { +class IntrinsicProcTable { private: struct Implementation; public: - ~IntrinsicTable(); - static IntrinsicTable Configure(const semantics::IntrinsicTypeDefaultKinds &); + ~IntrinsicProcTable(); + static IntrinsicProcTable Configure(const IntrinsicTypeDefaultKinds &); std::optional Probe(const CallCharacteristics &, parser::ContextualMessages *messages = nullptr) const; diff --git a/flang/lib/evaluate/type.cc b/flang/lib/evaluate/type.cc index 5a05752..6fab0ab 100644 --- a/flang/lib/evaluate/type.cc +++ b/flang/lib/evaluate/type.cc @@ -13,12 +13,45 @@ // limitations under the License. #include "type.h" +#include "../semantics/symbol.h" #include "../semantics/type.h" +#include #include using namespace std::literals::string_literals; namespace Fortran::evaluate { + +std::optional GetSymbolType(const semantics::Symbol &symbol) { + if (auto *details{symbol.detailsIf()}) { + if (details->type().has_value()) { + switch (details->type()->category()) { + case semantics::DeclTypeSpec::Category::Intrinsic: + return std::make_optional( + DynamicType{details->type()->intrinsicTypeSpec().category(), + details->type()->intrinsicTypeSpec().kind()}); + case semantics::DeclTypeSpec::Category::TypeDerived: + case semantics::DeclTypeSpec::Category::ClassDerived: + return std::make_optional(DynamicType{ + TypeCategory::Derived, 0, &details->type()->derivedTypeSpec()}); + default:; + } + } + } + return std::nullopt; +} + +int IntrinsicTypeDefaultKinds::DefaultKind(TypeCategory category) const { + switch (category) { + case TypeCategory::Integer: return defaultIntegerKind; + case TypeCategory::Real: + case TypeCategory::Complex: return defaultRealKind; + case TypeCategory::Character: return defaultCharacterKind; + case TypeCategory::Logical: return defaultLogicalKind; + default: CRASH_NO_CASE; return 0; + } +} + std::string SomeDerived::Dump() const { return "TYPE("s + spec().name().ToString() + ')'; } diff --git a/flang/lib/evaluate/type.h b/flang/lib/evaluate/type.h index fe49716..9b9251c 100644 --- a/flang/lib/evaluate/type.h +++ b/flang/lib/evaluate/type.h @@ -37,6 +37,7 @@ namespace Fortran::semantics { class DerivedTypeSpec; +class Symbol; } // namespace Fortran::semantics namespace Fortran::evaluate { @@ -57,6 +58,8 @@ struct DynamicType { const semantics::DerivedTypeSpec *derived{nullptr}; }; +std::optional GetSymbolType(const semantics::Symbol &); + // Specific intrinsic types are represented by specializations of // this class template Type. template class Type; @@ -64,6 +67,9 @@ template class Type; template struct TypeBase { static constexpr bool isSpecificType{true}; static constexpr DynamicType dynamicType{CATEGORY, KIND}; + static constexpr std::optional GetType() { + return {dynamicType}; + } static constexpr TypeCategory category{CATEGORY}; static constexpr int kind{KIND}; static std::string Dump() { return dynamicType.Dump(); } @@ -170,6 +176,16 @@ using DefaultComplex = SameKind; using DefaultLogical = Type; using DefaultCharacter = Type; +struct IntrinsicTypeDefaultKinds { + int defaultIntegerKind{evaluate::DefaultInteger::kind}; + int defaultRealKind{evaluate::DefaultReal::kind}; + int defaultDoublePrecisionKind{evaluate::DefaultDoublePrecision::kind}; + int defaultQuadPrecisionKind{evaluate::DefaultDoublePrecision::kind}; + int defaultCharacterKind{evaluate::DefaultCharacter::kind}; + int defaultLogicalKind{evaluate::DefaultLogical::kind}; + int DefaultKind(TypeCategory) const; +}; + using SubscriptInteger = Type; using LogicalResult = Type; using LargestReal = Type; @@ -278,6 +294,15 @@ template struct SomeScalar { u); } + std::optional GetType() const { + return std::visit( + [](const auto &x) { + using Ty = std::decay_t; + return TypeOf::GetType(); + }, + u); + } + common::MapTemplate u; }; @@ -301,6 +326,9 @@ public: CLASS_BOILERPLATE(SomeKind) explicit SomeKind(const semantics::DerivedTypeSpec &s) : spec_{&s} {} + std::optional GetType() const { + return {DynamicType{category, 0, spec_}}; + } const semantics::DerivedTypeSpec &spec() const { return *spec_; } std::string Dump() const; diff --git a/flang/lib/evaluate/variable.cc b/flang/lib/evaluate/variable.cc index 841cbe7..b90fd01 100644 --- a/flang/lib/evaluate/variable.cc +++ b/flang/lib/evaluate/variable.cc @@ -323,10 +323,6 @@ std::ostream &SubroutineCall::Dump(std::ostream &o) const { return o << ')'; } -std::ostream &ActualSubroutineArg::Dump(std::ostream &o) const { - return Emit(o, u); -} - std::ostream &Label::Dump(std::ostream &o) const { return o << '*' << std::dec << label; } @@ -449,17 +445,6 @@ int ProcedureDesignator::Rank() const { [](const Component &c) { return c.symbol().Rank(); }}, u); } -int ActualSubroutineArg::Rank() const { - return std::visit(common::visitors{[](const ActualFunctionArg &a) { - if (a.has_value()) { - return (*a)->Rank(); - } else { - return 0; - } - }, - [](const Label *) { return 0; }}, - u); -} // GetSymbol const Symbol *Component::GetSymbol(bool first) const { diff --git a/flang/lib/evaluate/variable.h b/flang/lib/evaluate/variable.h index 4954ef6..1f2b5c3 100644 --- a/flang/lib/evaluate/variable.h +++ b/flang/lib/evaluate/variable.h @@ -37,7 +37,6 @@ namespace Fortran::evaluate { using semantics::Symbol; // Forward declarations -template class Expr; struct DataRef; template struct Variable; @@ -221,8 +220,8 @@ private: // R901 designator is the most general data reference object, apart from // calls to pointer-valued functions. Its variant holds everything that -// a DataRef can, and, when appropriate for the result type, a substring -// reference or complex part (%RE/%IM). +// a DataRef can, and possibly either a substring reference or a complex +// part (%RE/%IM) reference. template class Designator { using DataRefs = decltype(DataRef::u); using MaybeSubstring = @@ -237,11 +236,20 @@ public: using Result = A; static_assert(Result::isSpecificType); EVALUATE_UNION_CLASS_BOILERPLATE(Designator) - explicit Designator(DataRef &&that) + Designator(const DataRef &that) : u{common::MoveVariant(that.u)} {} + Designator(DataRef &&that) : u{common::MoveVariant(std::move(that.u))} {} - Designator &operator=(DataRef &&that) { - *this = Designator{std::move(that)}; - return *this; + + std::optional GetType() const { + if constexpr (std::is_same_v) { + if (const Symbol * sym{GetSymbol(false)}) { + return GetSymbolType(*sym); + } else { + return std::nullopt; + } + } else { + return Result::GetType(); + } } int Rank() const { @@ -271,6 +279,7 @@ public: Variant u; }; +// TODO pmk: move more of these into call.h/cc... struct ProcedureDesignator { EVALUATE_UNION_CLASS_BOILERPLATE(ProcedureDesignator) explicit ProcedureDesignator(IntrinsicProcedure p) : u{p} {} @@ -283,12 +292,8 @@ struct ProcedureDesignator { std::variant u; }; -using ActualFunctionArg = std::optional>>; - class UntypedFunctionRef { public: - using Argument = ActualFunctionArg; - using Arguments = std::vector; CLASS_BOILERPLATE(UntypedFunctionRef) UntypedFunctionRef(ProcedureDesignator &&p, Arguments &&a, int r) : proc_{std::move(p)}, arguments_(std::move(a)), rank_{r} {} @@ -316,19 +321,29 @@ template struct FunctionRef : public UntypedFunctionRef { // e.g. between X and (X). The parser attempts to parse each argument // first as a variable, then as an expression, and the distinction appears // in the parse tree. - using Argument = ActualFunctionArg; - using Arguments = std::vector; CLASS_BOILERPLATE(FunctionRef) - explicit FunctionRef(UntypedFunctionRef &&ufr) - : UntypedFunctionRef{std::move(ufr)} {} - FunctionRef(ProcedureDesignator &&p, Arguments &&a, int r = 0) - : UntypedFunctionRef{std::move(p), std::move(a), r} {} + FunctionRef(UntypedFunctionRef &&ufr) : UntypedFunctionRef{std::move(ufr)} {} + FunctionRef(ProcedureDesignator &&p, Arguments &&a, int rank = 0) + : UntypedFunctionRef{std::move(p), std::move(a), rank} {} + std::optional GetType() const { + if constexpr (std::is_same_v) { + if (const Symbol * symbol{proc_.GetSymbol()}) { + return GetSymbolType(*symbol); + } + } else { + return Result::GetType(); + } + return std::nullopt; + } }; template struct Variable { using Result = A; static_assert(Result::isSpecificType); EVALUATE_UNION_CLASS_BOILERPLATE(Variable) + std::optional GetType() const { + return std::visit([](const auto &x) { return x.GetType(); }, u); + } int Rank() const { return std::visit([](const auto &x) { return x.Rank(); }, u); } @@ -346,22 +361,8 @@ struct Label { // TODO: this is a placeholder std::ostream &Dump(std::ostream &) const; }; -class ActualSubroutineArg { -public: - EVALUATE_UNION_CLASS_BOILERPLATE(ActualSubroutineArg) - explicit ActualSubroutineArg(ActualFunctionArg &&x) : u{std::move(x)} {} - explicit ActualSubroutineArg(const Label &l) : u{&l} {} - int Rank() const; - std::ostream &Dump(std::ostream &) const; - -public: - std::variant u; -}; - class SubroutineCall { public: - using Argument = ActualSubroutineArg; - using Arguments = std::vector; CLASS_BOILERPLATE(SubroutineCall) SubroutineCall(ProcedureDesignator &&p, Arguments &&a) : proc_{std::move(p)}, arguments_(std::move(a)) {} diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index 4d36e95..a07bb2e 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -21,7 +21,7 @@ #include "../parser/parse-tree-visitor.h" #include "../parser/parse-tree.h" #include -#include // TODO remove soon +#include // TODO pmk remove soon #include using namespace Fortran::parser::literals; @@ -105,14 +105,14 @@ std::optional ExtractDataRef(std::optional &&x) { // member function that converts parse trees into (usually) generic // expressions. struct ExprAnalyzer { - ExprAnalyzer( - FoldingContext &ctx, const semantics::IntrinsicTypeDefaultKinds &dfts) - : context{ctx}, defaults{dfts} {} + ExprAnalyzer(FoldingContext &ctx, const IntrinsicTypeDefaultKinds &dfts, + const IntrinsicProcTable &procs) + : context{ctx}, defaults{dfts}, intrinsics{procs} {} ExprAnalyzer(const ExprAnalyzer &that, const parser::CharBlock &source) : context{that.context, parser::ContextualMessages{source, that.context.messages}}, - defaults{that.defaults} {} + defaults{that.defaults}, intrinsics{that.intrinsics} {} MaybeExpr Analyze(const parser::Expr &); MaybeExpr Analyze(const parser::CharLiteralConstantSubstring &); @@ -181,10 +181,11 @@ struct ExprAnalyzer { void CheckUnsubscriptedComponent(const Component &); std::optional Procedure( - const parser::ProcedureDesignator &); + const parser::ProcedureDesignator &, const std::vector &); FoldingContext context; - const semantics::IntrinsicTypeDefaultKinds &defaults; + const IntrinsicTypeDefaultKinds &defaults; + const IntrinsicProcTable &intrinsics; }; // This helper template function handles the Scalar<>, Integer<>, and @@ -483,24 +484,6 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::BOZLiteralConstant &x) { return {AsGenericExpr(std::move(value.value))}; } -static std::optional CategorizeSymbolType(const Symbol &symbol) { - if (auto *details{symbol.detailsIf()}) { - if (details->type().has_value()) { - switch (details->type()->category()) { - case semantics::DeclTypeSpec::Category::Intrinsic: - return std::make_optional( - DynamicType{details->type()->intrinsicTypeSpec().category(), - details->type()->intrinsicTypeSpec().kind()}); - case semantics::DeclTypeSpec::Category::TypeDerived: - case semantics::DeclTypeSpec::Category::ClassDerived: - return std::make_optional(DynamicType{TypeCategory::Derived}); - default:; - } - } - } - return std::nullopt; -} - // Wraps a object in an explicitly typed representation (e.g., Designator<> // or FunctionRef<>) as instantiated on a dynamic type. // TODO: move to tools.h? @@ -530,8 +513,7 @@ MaybeExpr TypedWrapper(DynamicType &&dyType, WRAPPED &&x) { return WrapperHelper( dyType.kind, std::move(x)); case TypeCategory::Derived: - return AsGenericExpr( - Expr{*dyType.derived, WRAPPER{std::move(x)}}); + return AsGenericExpr(Expr{WRAPPER{std::move(x)}}); default: CRASH_NO_CASE; } } @@ -539,7 +521,7 @@ MaybeExpr TypedWrapper(DynamicType &&dyType, WRAPPED &&x) { // Wraps a data reference in a typed Designator<>. static MaybeExpr Designate(DataRef &&dataRef) { const Symbol &symbol{*dataRef.GetSymbol(false)}; - if (std::optional dyType{CategorizeSymbolType(symbol)}) { + if (std::optional dyType{GetSymbolType(symbol)}) { return TypedWrapper( std::move(*dyType), std::move(dataRef)); } @@ -590,8 +572,7 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::Substring &ss) { std::optional> last{ GetSubstringBound(std::get<1>(range.t))}; const Symbol &symbol{*checked->GetSymbol(false)}; - if (std::optional dynamicType{ - CategorizeSymbolType(symbol)}) { + if (std::optional dynamicType{GetSymbolType(symbol)}) { if (dynamicType->category == TypeCategory::Character) { return WrapperHelper(dynamicType->kind, @@ -766,17 +747,24 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::StructureComponent &sc) { if (MaybeExpr base{AnalyzeHelper(*this, sc.base)}) { if (auto *dtExpr{std::get_if>(&base->u)}) { Symbol *sym{sc.component.symbol}; + const semantics::DerivedTypeSpec *dtSpec{nullptr}; + if (std::optional dtDyTy{dtExpr->GetType()}) { + dtSpec = dtDyTy->derived; + } if (sym == nullptr) { context.messages.Say(sc.component.source, "component name was not resolved to a symbol"_err_en_US); } else if (sym->detailsIf()) { context.messages.Say(sc.component.source, "TODO: type parameter inquiry unimplemented"_err_en_US); - } else if (&sym->owner() != dtExpr->result.spec().scope()) { + } else if (dtSpec == nullptr) { + context.messages.Say(sc.component.source, + "TODO: base of component reference lacks a derived type"_err_en_US); + } else if (&sym->owner() != dtSpec->scope()) { // TODO: extended derived types - insert explicit reference to base? context.messages.Say(sc.component.source, "component is not in scope of derived TYPE(%s)"_err_en_US, - dtExpr->result.spec().name().ToString().data()); + dtSpec->name().ToString().data()); } else if (std::optional dataRef{ ExtractDataRef(std::move(*dtExpr))}) { Component component{std::move(*dataRef), *sym}; @@ -835,7 +823,8 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::StructureConstructor &) { } std::optional ExprAnalyzer::Procedure( - const parser::ProcedureDesignator &pd) { + const parser::ProcedureDesignator &pd, + const std::vector &arg) { return std::visit( common::visitors{ [&](const parser::Name &n) -> std::optional { @@ -846,12 +835,30 @@ std::optional ExprAnalyzer::Procedure( return std::nullopt; } return std::visit( - common::visitors{[&](const semantics::ProcEntityDetails &p) - -> std::optional { - // TODO: capture &/or check interface vs. - // actual arguments - return {ProcedureDesignator{*n.symbol}}; - }, + common::visitors{ + [&](const semantics::ProcEntityDetails &p) + -> std::optional { + if (!p.HasExplicitInterface()) { + std::cerr + << "pmk: arg[0] cat " + << static_cast(arg[0].GetType()->category) + << '\n'; + CallCharacteristics cc{n.source, arg}; + std::optional si{ + intrinsics.Probe(cc, &context.messages)}; + if (si) { + context.messages.Say(n.source, + "pmk debug: Probe succeeds: %s %s %d"_en_US, + si->name, si->type.Dump().data(), si->rank); + } else { + context.messages.Say( + n.source, "pmk debug: Probe failed"_en_US); + } + } + // TODO: capture &/or check interface vs. + // actual arguments + return {ProcedureDesignator{*n.symbol}}; + }, [&](const auto &) -> std::optional { context.messages.Say( "TODO: unimplemented/invalid kind of symbol as procedure designator '%s'"_err_en_US, @@ -879,18 +886,9 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::FunctionReference &funcRef) { // TODO: C1002: Allow a whole assumed-size array to appear if the dummy // argument would accept it. Handle by special-casing the context // ActualArg -> Variable -> Designator. - - std::optional proc{ - Procedure(std::get(funcRef.v.t))}; - - typename UntypedFunctionRef::Arguments arguments; + Arguments arguments; for (const auto &arg : std::get>(funcRef.v.t)) { - std::optional keyword; - if (const auto &argKW{std::get>(arg.t)}) { - keyword = argKW->v.source; - } - // TODO: look up dummy argument info by number/keyword MaybeExpr actualArgExpr; std::visit( common::visitors{[&](const common::Indirection &v) { @@ -920,20 +918,25 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::FunctionReference &funcRef) { if (actualArgExpr.has_value()) { CopyableIndirection> indExpr{std::move(*actualArgExpr)}; arguments.emplace_back(std::move(indExpr)); + if (const auto &argKW{std::get>(arg.t)}) { + arguments.back().keyword = argKW->v.source; + } } else { - arguments.emplace_back(); + return std::nullopt; } } - // TODO: Look up user function, try to map generic to specific procedure - // TODO: validate arguments against interface, discarding messages if - // an intrinsic function is a better match + // TODO: map generic to specific procedure + // TODO: validate arguments against interface // TODO: distinguish applications of elemental functions - + std::cerr << "pmk: arguments size " << arguments.size() << ", arg[0] cat " + << static_cast(arguments[0].GetType()->category) << '\n'; + std::optional proc{ + Procedure(std::get(funcRef.v.t), arguments)}; if (proc.has_value()) { std::optional dyType; if (const Symbol * symbol{proc->GetSymbol()}) { - dyType = CategorizeSymbolType(*symbol); + dyType = GetSymbolType(*symbol); } else { // TODO: intrinsic function result type - this is a placeholder dyType = DynamicType{TypeCategory::Real, 4}; @@ -1217,34 +1220,26 @@ void ExprAnalyzer::CheckUnsubscriptedComponent(const Component &component) { namespace Fortran::semantics { -int IntrinsicTypeDefaultKinds::DefaultKind(TypeCategory category) const { - switch (category) { - case TypeCategory::Integer: return defaultIntegerKind; - case TypeCategory::Real: - case TypeCategory::Complex: return defaultRealKind; - case TypeCategory::Character: return defaultCharacterKind; - case TypeCategory::Logical: return defaultLogicalKind; - default: CRASH_NO_CASE; return 0; - } -} - evaluate::MaybeExpr AnalyzeExpr(evaluate::FoldingContext &context, - const IntrinsicTypeDefaultKinds &defaults, const parser::Expr &expr) { - return evaluate::ExprAnalyzer{context, defaults}.Analyze(expr); + const evaluate::IntrinsicTypeDefaultKinds &defaults, + const evaluate::IntrinsicProcTable &intrinsics, const parser::Expr &expr) { + return evaluate::ExprAnalyzer{context, defaults, intrinsics}.Analyze(expr); } class Mutator { public: Mutator(evaluate::FoldingContext &context, - const IntrinsicTypeDefaultKinds &defaults) - : context_{context}, defaults_{defaults} {} + const evaluate::IntrinsicTypeDefaultKinds &defaults, + const evaluate::IntrinsicProcTable &intrinsics) + : context_{context}, defaults_{defaults}, intrinsics_{intrinsics} {} template bool Pre(A &) { return true /* visit children */; } template void Post(A &) {} bool Pre(parser::Expr &expr) { if (expr.typedExpr.get() == nullptr) { - if (MaybeExpr checked{AnalyzeExpr(context_, defaults_, expr)}) { + if (MaybeExpr checked{ + AnalyzeExpr(context_, defaults_, intrinsics_, expr)}) { checked->Dump(std::cout << "checked expression: ") << '\n'; expr.typedExpr.reset( new evaluate::GenericExprWrapper{std::move(*checked)}); @@ -1258,14 +1253,15 @@ public: private: evaluate::FoldingContext &context_; - const IntrinsicTypeDefaultKinds &defaults_; + const evaluate::IntrinsicTypeDefaultKinds &defaults_; + const evaluate::IntrinsicProcTable &intrinsics_; }; void AnalyzeExpressions(parser::Program &program, evaluate::FoldingContext &context, - const IntrinsicTypeDefaultKinds &defaults) { - Mutator mutator{context, defaults}; + const evaluate::IntrinsicTypeDefaultKinds &defaults, + const evaluate::IntrinsicProcTable &intrinsics) { + Mutator mutator{context, defaults, intrinsics}; parser::Walk(program, mutator); } - } // namespace Fortran::semantics diff --git a/flang/lib/semantics/expression.h b/flang/lib/semantics/expression.h index 05fbab5..d937754 100644 --- a/flang/lib/semantics/expression.h +++ b/flang/lib/semantics/expression.h @@ -24,25 +24,16 @@ namespace Fortran::semantics { using MaybeExpr = std::optional>; -struct IntrinsicTypeDefaultKinds { - int defaultIntegerKind{evaluate::DefaultInteger::kind}; - int defaultRealKind{evaluate::DefaultReal::kind}; - int defaultDoublePrecisionKind{evaluate::DefaultDoublePrecision::kind}; - int defaultQuadPrecisionKind{evaluate::DefaultDoublePrecision::kind}; - int defaultCharacterKind{evaluate::DefaultCharacter::kind}; - int defaultLogicalKind{evaluate::DefaultLogical::kind}; - int DefaultKind(TypeCategory) const; -}; - // Semantic analysis of one expression. std::optional> AnalyzeExpr( - evaluate::FoldingContext &, const IntrinsicTypeDefaultKinds &, + evaluate::FoldingContext &, const evaluate::IntrinsicTypeDefaultKinds &, const parser::Expr &); // Semantic analysis of all expressions in a parse tree, which is // decorated with typed representations for top-level expressions. void AnalyzeExpressions(parser::Program &, evaluate::FoldingContext &, - const IntrinsicTypeDefaultKinds &); + const evaluate::IntrinsicTypeDefaultKinds &, + const evaluate::IntrinsicProcTable &); } // namespace Fortran::semantics #endif // FORTRAN_SEMANTICS_EXPRESSION_H_ diff --git a/flang/tools/f18/f18.cc b/flang/tools/f18/f18.cc index d2294e4..e1e0a5b 100644 --- a/flang/tools/f18/f18.cc +++ b/flang/tools/f18/f18.cc @@ -219,8 +219,11 @@ std::string CompileFortran(std::string path, Fortran::parser::Options options, Fortran::parser::Messages messages; Fortran::parser::ContextualMessages contextualMessages{whole, &messages}; Fortran::evaluate::FoldingContext context{contextualMessages}; - Fortran::semantics::IntrinsicTypeDefaultKinds defaults; - Fortran::semantics::AnalyzeExpressions(parseTree, context, defaults); + Fortran::evaluate::IntrinsicTypeDefaultKinds defaults; + auto intrinsics{ + Fortran::evaluate::IntrinsicProcTable::Configure(defaults)}; + Fortran::semantics::AnalyzeExpressions( + parseTree, context, defaults, intrinsics); messages.Emit(std::cerr, parsing.cooked()); if (!messages.empty() && (driver.warningsAreErrors || messages.AnyFatalError())) { -- 2.7.4