forked from OSchip/llvm-project
[flang] debug initial intrinsic table probes
Original-commit: flang-compiler/f18@dce9a1e173 Reviewed-on: https://github.com/flang-compiler/f18/pull/212 Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler
parent
cb308d32a1
commit
a62636f634
|
|
@ -83,7 +83,7 @@ template<typename UINT> inline constexpr bool Parity(UINT x) {
|
|||
// "Parity is for farmers." -- Seymour R. Cray
|
||||
|
||||
template<typename UINT> 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_
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@
|
|||
# limitations under the License.
|
||||
|
||||
add_library(FortranEvaluate
|
||||
call.cc
|
||||
common.cc
|
||||
complex.cc
|
||||
expression.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<DynamicType> 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
|
||||
|
|
@ -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 <optional>
|
||||
#include <ostream>
|
||||
#include <vector>
|
||||
|
||||
namespace Fortran::evaluate {
|
||||
|
||||
struct ActualArgument {
|
||||
explicit ActualArgument(CopyableIndirection<Expr<SomeType>> &&v)
|
||||
: value{std::move(v)} {}
|
||||
std::optional<DynamicType> GetType() const;
|
||||
int Rank() const;
|
||||
std::ostream &Dump(std::ostream &) const;
|
||||
|
||||
std::optional<parser::CharBlock> keyword;
|
||||
bool isAssumedRank{false};
|
||||
bool isAlternateReturn{false};
|
||||
std::optional<int> vectorSize; // TODO: pmk replace with function on value
|
||||
std::optional<int> intValue; // TODO: pmk replace with function on value
|
||||
CopyableIndirection<Expr<SomeType>> value;
|
||||
};
|
||||
|
||||
using Arguments = std::vector<ActualArgument>;
|
||||
|
||||
} // namespace Fortran::evaluate
|
||||
#endif // FORTRAN_EVALUATE_CALL_H_
|
||||
|
|
@ -138,6 +138,10 @@ using HostUnsignedInt =
|
|||
// Force availability of copy construction and assignment
|
||||
template<typename A> using CopyableIndirection = common::Indirection<A, true>;
|
||||
|
||||
// Forward definition of Expr<> so that it can be indirectly used in its own
|
||||
// definition
|
||||
template<typename A> class Expr;
|
||||
|
||||
// Classes that support a Fold(FoldingContext &) member function have the
|
||||
// IsFoldableTrait.
|
||||
CLASS_TRAIT(IsFoldableTrait)
|
||||
|
|
|
|||
|
|
@ -472,6 +472,11 @@ std::ostream &ExpressionBase<RESULT>::Dump(std::ostream &o) const {
|
|||
return o;
|
||||
}
|
||||
|
||||
std::ostream &Expr<SomeDerived>::Dump(std::ostream &o) const {
|
||||
std::visit([&](const auto &x) { x.Dump(o); }, u);
|
||||
return o;
|
||||
}
|
||||
|
||||
template<int KIND>
|
||||
Expr<SubscriptInteger> Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
|
||||
return std::visit(
|
||||
|
|
@ -534,7 +539,32 @@ auto ExpressionBase<RESULT>::ScalarValue() const
|
|||
|
||||
Expr<SomeType>::~Expr() {}
|
||||
|
||||
// Rank()
|
||||
template<typename A>
|
||||
std::optional<DynamicType> ExpressionBase<A>::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<DynamicType> {
|
||||
if constexpr (std::is_same_v<std::decay_t<decltype(x)>,
|
||||
BOZLiteralConstant>) {
|
||||
return std::nullopt; // typeless -> no type
|
||||
} else {
|
||||
return x.GetType();
|
||||
}
|
||||
},
|
||||
derived().u);
|
||||
}
|
||||
}
|
||||
|
||||
std::optional<DynamicType> Expr<SomeDerived>::GetType() const {
|
||||
return std::visit([](const auto &x) { return x.GetType(); }, u);
|
||||
}
|
||||
|
||||
template<typename A> int ExpressionBase<A>::Rank() const {
|
||||
return std::visit(
|
||||
[](const auto &x) {
|
||||
|
|
@ -548,6 +578,10 @@ template<typename A> int ExpressionBase<A>::Rank() const {
|
|||
derived().u);
|
||||
}
|
||||
|
||||
int Expr<SomeDerived>::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.
|
||||
|
||||
|
|
|
|||
|
|
@ -45,12 +45,23 @@ using common::RelationalOperator;
|
|||
// can be valid expressions in that context:
|
||||
// - Expr<Type<CATEGORY, KIND>> represents an expression whose result is of a
|
||||
// specific intrinsic type category and kind, e.g. Type<TypeCategory::Real, 4>
|
||||
// - Expr<SomeDerived> wraps data and procedure references that result in an
|
||||
// instance of a derived type
|
||||
// - Expr<SomeKind<CATEGORY>> is a union of Expr<Type<CATEGORY, K>> for each
|
||||
// kind type parameter value K in that intrinsic type category. It represents
|
||||
// an expression with known category and any kind.
|
||||
// - Expr<SomeType> is a union of Expr<SomeKind<CATEGORY>> over the five
|
||||
// intrinsic type categories of Fortran. It represents any valid expression.
|
||||
template<typename A> 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<Constant<Result>> Fold(FoldingContext &c);
|
||||
// std::optional<Scalar<Result>> 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<typename T> struct Constant {
|
|||
template<typename A>
|
||||
Constant(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
|
||||
: value(std::move(x)) {}
|
||||
constexpr std::optional<DynamicType> 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<typename DERIVED, typename RESULT, typename... OPERANDS>
|
||||
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<int J> using Operand = std::tuple_element_t<J, OperandTypes>;
|
||||
using IsFoldableTrait = std::true_type;
|
||||
|
|
@ -155,6 +174,9 @@ public:
|
|||
}
|
||||
}
|
||||
|
||||
static constexpr std::optional<DynamicType> GetType() {
|
||||
return Result::GetType();
|
||||
}
|
||||
int Rank() const {
|
||||
int rank{left().Rank()};
|
||||
if constexpr (operands > 1) {
|
||||
|
|
@ -416,6 +438,7 @@ template<typename RESULT> struct ExpressionBase {
|
|||
return d;
|
||||
}
|
||||
|
||||
std::optional<DynamicType> GetType() const;
|
||||
int Rank() const;
|
||||
std::ostream &Dump(std::ostream &) const;
|
||||
std::optional<Constant<Result>> Fold(FoldingContext &c);
|
||||
|
|
@ -554,6 +577,9 @@ template<> class Relational<SomeType> {
|
|||
public:
|
||||
using Result = LogicalResult;
|
||||
EVALUATE_UNION_CLASS_BOILERPLATE(Relational)
|
||||
static constexpr std::optional<DynamicType> GetType() {
|
||||
return Result::GetType();
|
||||
}
|
||||
int Rank() const {
|
||||
return std::visit([](const auto &x) { return x.Rank(); }, u);
|
||||
}
|
||||
|
|
@ -601,20 +627,19 @@ public:
|
|||
common::MapTemplate<Expr, CategoryTypes<CAT>> u;
|
||||
};
|
||||
|
||||
template<> class Expr<SomeDerived> : public ExpressionBase<SomeDerived> {
|
||||
// Note that Expr<SomeDerived> does not inherit from ExpressionBase
|
||||
// since Constant<SomeDerived> and Scalar<SomeDerived> are not defined
|
||||
// for derived types..
|
||||
template<> class Expr<SomeDerived> {
|
||||
public:
|
||||
using Result = SomeDerived;
|
||||
using IsFoldableTrait = std::false_type;
|
||||
CLASS_BOILERPLATE(Expr)
|
||||
EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
|
||||
|
||||
template<typename A>
|
||||
explicit Expr(const semantics::DerivedTypeSpec &dts, const A &x)
|
||||
: result{dts}, u{x} {}
|
||||
template<typename A>
|
||||
explicit Expr(Result &&r, std::enable_if_t<!std::is_reference_v<A>, A> &&x)
|
||||
: result{std::move(r)}, u{std::move(x)} {}
|
||||
std::optional<DynamicType> GetType() const;
|
||||
int Rank() const;
|
||||
std::ostream &Dump(std::ostream &) const;
|
||||
|
||||
Result result;
|
||||
std::variant<Designator<Result>, FunctionRef<Result>> 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_
|
||||
|
|
|
|||
|
|
@ -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 <map>
|
||||
#include <string>
|
||||
#include <utility>
|
||||
|
|
@ -186,7 +186,7 @@ struct IntrinsicInterface {
|
|||
TypePattern result;
|
||||
Rank rank{Rank::elemental};
|
||||
std::optional<SpecificIntrinsic> 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<SpecificIntrinsic> 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<SpecificIntrinsic> 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<SpecificIntrinsic> 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<SpecificIntrinsic> IntrinsicInterface::Match(
|
|||
continue;
|
||||
}
|
||||
}
|
||||
if (arg->isBOZ) {
|
||||
CHECK(arg->rank == 0);
|
||||
std::optional<DynamicType> 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<SpecificIntrinsic> 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<SpecificIntrinsic> 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<SpecificIntrinsic> 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<SpecificIntrinsic> 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<SpecificIntrinsic> 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<SpecificIntrinsic> 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<SpecificIntrinsic> 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<SpecificIntrinsic> 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<SpecificIntrinsic> 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<SpecificIntrinsic> Probe(
|
||||
const CallCharacteristics &, parser::ContextualMessages *) const;
|
||||
|
||||
semantics::IntrinsicTypeDefaultKinds defaults;
|
||||
IntrinsicTypeDefaultKinds defaults;
|
||||
std::multimap<std::string, const IntrinsicInterface *> genericFuncs;
|
||||
std::multimap<std::string, const SpecificIntrinsicInterface *> specificFuncs;
|
||||
};
|
||||
|
||||
// Probe the configured intrinsic procedure pattern tables in search of a
|
||||
// match for a given procedure reference.
|
||||
std::optional<SpecificIntrinsic> IntrinsicTable::Implementation::Probe(
|
||||
std::optional<SpecificIntrinsic> IntrinsicProcTable::Implementation::Probe(
|
||||
const CallCharacteristics &call,
|
||||
parser::ContextualMessages *messages) const {
|
||||
if (call.isSubroutineCall) {
|
||||
|
|
@ -885,23 +891,23 @@ std::optional<SpecificIntrinsic> 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<SpecificIntrinsic> IntrinsicTable::Probe(
|
||||
std::optional<SpecificIntrinsic> 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
|
||||
|
|
|
|||
|
|
@ -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 <optional>
|
||||
#include <vector>
|
||||
|
||||
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<parser::CharBlock> keyword;
|
||||
bool isBOZ{false};
|
||||
bool isAssumedRank{false};
|
||||
DynamicType type;
|
||||
int rank;
|
||||
std::optional<int> vectorSize;
|
||||
std::optional<int> intValue;
|
||||
};
|
||||
|
||||
struct CallCharacteristics {
|
||||
bool isSubroutineCall{false};
|
||||
parser::CharBlock name;
|
||||
std::vector<ActualArgumentCharacteristics> argument;
|
||||
const std::vector<ActualArgument> &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<SpecificIntrinsic> Probe(const CallCharacteristics &,
|
||||
parser::ContextualMessages *messages = nullptr) const;
|
||||
|
||||
|
|
|
|||
|
|
@ -13,12 +13,45 @@
|
|||
// limitations under the License.
|
||||
|
||||
#include "type.h"
|
||||
#include "../semantics/symbol.h"
|
||||
#include "../semantics/type.h"
|
||||
#include <optional>
|
||||
#include <string>
|
||||
|
||||
using namespace std::literals::string_literals;
|
||||
|
||||
namespace Fortran::evaluate {
|
||||
|
||||
std::optional<DynamicType> GetSymbolType(const semantics::Symbol &symbol) {
|
||||
if (auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
|
||||
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() + ')';
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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<DynamicType> GetSymbolType(const semantics::Symbol &);
|
||||
|
||||
// Specific intrinsic types are represented by specializations of
|
||||
// this class template Type<CATEGORY, KIND>.
|
||||
template<TypeCategory CATEGORY, int KIND = 0> class Type;
|
||||
|
|
@ -64,6 +67,9 @@ template<TypeCategory CATEGORY, int KIND = 0> class Type;
|
|||
template<TypeCategory CATEGORY, int KIND> struct TypeBase {
|
||||
static constexpr bool isSpecificType{true};
|
||||
static constexpr DynamicType dynamicType{CATEGORY, KIND};
|
||||
static constexpr std::optional<DynamicType> 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<TypeCategory::Complex, DefaultReal>;
|
|||
using DefaultLogical = Type<TypeCategory::Logical, DefaultInteger::kind>;
|
||||
using DefaultCharacter = Type<TypeCategory::Character, 1>;
|
||||
|
||||
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<TypeCategory::Integer, 8>;
|
||||
using LogicalResult = Type<TypeCategory::Logical, 1>;
|
||||
using LargestReal = Type<TypeCategory::Real, 16>;
|
||||
|
|
@ -278,6 +294,15 @@ template<typename TYPES> struct SomeScalar {
|
|||
u);
|
||||
}
|
||||
|
||||
std::optional<DynamicType> GetType() const {
|
||||
return std::visit(
|
||||
[](const auto &x) {
|
||||
using Ty = std::decay_t<decltype(x)>;
|
||||
return TypeOf<Ty>::GetType();
|
||||
},
|
||||
u);
|
||||
}
|
||||
|
||||
common::MapTemplate<Scalar, Types> u;
|
||||
};
|
||||
|
||||
|
|
@ -301,6 +326,9 @@ public:
|
|||
CLASS_BOILERPLATE(SomeKind)
|
||||
explicit SomeKind(const semantics::DerivedTypeSpec &s) : spec_{&s} {}
|
||||
|
||||
std::optional<DynamicType> GetType() const {
|
||||
return {DynamicType{category, 0, spec_}};
|
||||
}
|
||||
const semantics::DerivedTypeSpec &spec() const { return *spec_; }
|
||||
std::string Dump() const;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 {
|
||||
|
|
|
|||
|
|
@ -37,7 +37,6 @@ namespace Fortran::evaluate {
|
|||
using semantics::Symbol;
|
||||
|
||||
// Forward declarations
|
||||
template<typename A> class Expr;
|
||||
struct DataRef;
|
||||
template<typename A> 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<typename A> 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<Variant>(that.u)} {}
|
||||
Designator(DataRef &&that)
|
||||
: u{common::MoveVariant<Variant>(std::move(that.u))} {}
|
||||
Designator &operator=(DataRef &&that) {
|
||||
*this = Designator{std::move(that)};
|
||||
return *this;
|
||||
|
||||
std::optional<DynamicType> GetType() const {
|
||||
if constexpr (std::is_same_v<Result, SomeDerived>) {
|
||||
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<IntrinsicProcedure, const Symbol *, Component> u;
|
||||
};
|
||||
|
||||
using ActualFunctionArg = std::optional<CopyableIndirection<Expr<SomeType>>>;
|
||||
|
||||
class UntypedFunctionRef {
|
||||
public:
|
||||
using Argument = ActualFunctionArg;
|
||||
using Arguments = std::vector<Argument>;
|
||||
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<typename A> 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<Argument>;
|
||||
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<DynamicType> GetType() const {
|
||||
if constexpr (std::is_same_v<Result, SomeDerived>) {
|
||||
if (const Symbol * symbol{proc_.GetSymbol()}) {
|
||||
return GetSymbolType(*symbol);
|
||||
}
|
||||
} else {
|
||||
return Result::GetType();
|
||||
}
|
||||
return std::nullopt;
|
||||
}
|
||||
};
|
||||
|
||||
template<typename A> struct Variable {
|
||||
using Result = A;
|
||||
static_assert(Result::isSpecificType);
|
||||
EVALUATE_UNION_CLASS_BOILERPLATE(Variable)
|
||||
std::optional<DynamicType> 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<ActualFunctionArg, const Label *> u;
|
||||
};
|
||||
|
||||
class SubroutineCall {
|
||||
public:
|
||||
using Argument = ActualSubroutineArg;
|
||||
using Arguments = std::vector<Argument>;
|
||||
CLASS_BOILERPLATE(SubroutineCall)
|
||||
SubroutineCall(ProcedureDesignator &&p, Arguments &&a)
|
||||
: proc_{std::move(p)}, arguments_(std::move(a)) {}
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@
|
|||
#include "../parser/parse-tree-visitor.h"
|
||||
#include "../parser/parse-tree.h"
|
||||
#include <functional>
|
||||
#include <iostream> // TODO remove soon
|
||||
#include <iostream> // TODO pmk remove soon
|
||||
#include <optional>
|
||||
|
||||
using namespace Fortran::parser::literals;
|
||||
|
|
@ -105,14 +105,14 @@ std::optional<DataRef> ExtractDataRef(std::optional<A> &&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<ProcedureDesignator> Procedure(
|
||||
const parser::ProcedureDesignator &);
|
||||
const parser::ProcedureDesignator &, const std::vector<ActualArgument> &);
|
||||
|
||||
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<DynamicType> CategorizeSymbolType(const Symbol &symbol) {
|
||||
if (auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
|
||||
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<TypeCategory::Logical, WRAPPER, WRAPPED>(
|
||||
dyType.kind, std::move(x));
|
||||
case TypeCategory::Derived:
|
||||
return AsGenericExpr(
|
||||
Expr<SomeDerived>{*dyType.derived, WRAPPER<SomeDerived>{std::move(x)}});
|
||||
return AsGenericExpr(Expr<SomeDerived>{WRAPPER<SomeDerived>{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<DynamicType> dyType{CategorizeSymbolType(symbol)}) {
|
||||
if (std::optional<DynamicType> dyType{GetSymbolType(symbol)}) {
|
||||
return TypedWrapper<Designator, DataRef>(
|
||||
std::move(*dyType), std::move(dataRef));
|
||||
}
|
||||
|
|
@ -590,8 +572,7 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::Substring &ss) {
|
|||
std::optional<Expr<SubscriptInteger>> last{
|
||||
GetSubstringBound(std::get<1>(range.t))};
|
||||
const Symbol &symbol{*checked->GetSymbol(false)};
|
||||
if (std::optional<DynamicType> dynamicType{
|
||||
CategorizeSymbolType(symbol)}) {
|
||||
if (std::optional<DynamicType> dynamicType{GetSymbolType(symbol)}) {
|
||||
if (dynamicType->category == TypeCategory::Character) {
|
||||
return WrapperHelper<TypeCategory::Character, Designator,
|
||||
Substring>(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<Expr<SomeDerived>>(&base->u)}) {
|
||||
Symbol *sym{sc.component.symbol};
|
||||
const semantics::DerivedTypeSpec *dtSpec{nullptr};
|
||||
if (std::optional<DynamicType> 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<semantics::TypeParamDetails>()) {
|
||||
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> dataRef{
|
||||
ExtractDataRef(std::move(*dtExpr))}) {
|
||||
Component component{std::move(*dataRef), *sym};
|
||||
|
|
@ -835,7 +823,8 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::StructureConstructor &) {
|
|||
}
|
||||
|
||||
std::optional<ProcedureDesignator> ExprAnalyzer::Procedure(
|
||||
const parser::ProcedureDesignator &pd) {
|
||||
const parser::ProcedureDesignator &pd,
|
||||
const std::vector<ActualArgument> &arg) {
|
||||
return std::visit(
|
||||
common::visitors{
|
||||
[&](const parser::Name &n) -> std::optional<ProcedureDesignator> {
|
||||
|
|
@ -846,12 +835,30 @@ std::optional<ProcedureDesignator> ExprAnalyzer::Procedure(
|
|||
return std::nullopt;
|
||||
}
|
||||
return std::visit(
|
||||
common::visitors{[&](const semantics::ProcEntityDetails &p)
|
||||
-> std::optional<ProcedureDesignator> {
|
||||
// TODO: capture &/or check interface vs.
|
||||
// actual arguments
|
||||
return {ProcedureDesignator{*n.symbol}};
|
||||
},
|
||||
common::visitors{
|
||||
[&](const semantics::ProcEntityDetails &p)
|
||||
-> std::optional<ProcedureDesignator> {
|
||||
if (!p.HasExplicitInterface()) {
|
||||
std::cerr
|
||||
<< "pmk: arg[0] cat "
|
||||
<< static_cast<int>(arg[0].GetType()->category)
|
||||
<< '\n';
|
||||
CallCharacteristics cc{n.source, arg};
|
||||
std::optional<SpecificIntrinsic> 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<ProcedureDesignator> {
|
||||
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<ProcedureDesignator> proc{
|
||||
Procedure(std::get<parser::ProcedureDesignator>(funcRef.v.t))};
|
||||
|
||||
typename UntypedFunctionRef::Arguments arguments;
|
||||
Arguments arguments;
|
||||
for (const auto &arg :
|
||||
std::get<std::list<parser::ActualArgSpec>>(funcRef.v.t)) {
|
||||
std::optional<parser::CharBlock> keyword;
|
||||
if (const auto &argKW{std::get<std::optional<parser::Keyword>>(arg.t)}) {
|
||||
keyword = argKW->v.source;
|
||||
}
|
||||
// TODO: look up dummy argument info by number/keyword
|
||||
MaybeExpr actualArgExpr;
|
||||
std::visit(
|
||||
common::visitors{[&](const common::Indirection<parser::Variable> &v) {
|
||||
|
|
@ -920,20 +918,25 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::FunctionReference &funcRef) {
|
|||
if (actualArgExpr.has_value()) {
|
||||
CopyableIndirection<Expr<SomeType>> indExpr{std::move(*actualArgExpr)};
|
||||
arguments.emplace_back(std::move(indExpr));
|
||||
if (const auto &argKW{std::get<std::optional<parser::Keyword>>(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<int>(arguments[0].GetType()->category) << '\n';
|
||||
std::optional<ProcedureDesignator> proc{
|
||||
Procedure(std::get<parser::ProcedureDesignator>(funcRef.v.t), arguments)};
|
||||
if (proc.has_value()) {
|
||||
std::optional<DynamicType> 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<typename A> bool Pre(A &) { return true /* visit children */; }
|
||||
template<typename A> 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
|
||||
|
|
|
|||
|
|
@ -24,25 +24,16 @@ namespace Fortran::semantics {
|
|||
|
||||
using MaybeExpr = std::optional<evaluate::Expr<evaluate::SomeType>>;
|
||||
|
||||
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<evaluate::Expr<evaluate::SomeType>> 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_
|
||||
|
|
|
|||
|
|
@ -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())) {
|
||||
|
|
|
|||
Loading…
Reference in New Issue