// limitations under the License.
#include "characteristics.h"
+#include "intrinsics.h"
+#include "tools.h"
+#include "type.h"
+#include "../common/indirection.h"
+#include "../semantics/symbol.h"
#include <ostream>
#include <sstream>
#include <string>
namespace Fortran::evaluate::characteristics {
-bool DummyDataObject::operator==(const DummyDataObject &that) const {
- return attrs == that.attrs && intent == that.intent && type == that.type &&
- shape == that.shape && coshape == that.coshape;
+bool TypeAndShape::operator==(const TypeAndShape &that) const {
+ return type_ == that.type_ && shape_ == that.shape_ &&
+ isAssumedRank_ == that.isAssumedRank_;
}
-std::ostream &DummyDataObject::Dump(std::ostream &o) const {
- attrs.Dump(o, EnumToString);
- if (intent != common::Intent::Default) {
- o << "INTENT(" << common::EnumToString(intent) << ')';
+std::optional<TypeAndShape> TypeAndShape::Characterize(
+ const semantics::Symbol &symbol) {
+ if (const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
+ return Characterize(*object);
+ } else if (const auto *proc{
+ symbol.detailsIf<semantics::ProcEntityDetails>()}) {
+ return Characterize(*proc);
+ } else {
+ return std::nullopt;
+ }
+}
+
+std::optional<TypeAndShape> TypeAndShape::Characterize(
+ const semantics::Symbol *symbol) {
+ if (symbol != nullptr) {
+ return Characterize(*symbol);
+ } else {
+ return std::nullopt;
+ }
+}
+
+std::optional<TypeAndShape> TypeAndShape::Characterize(
+ const semantics::ObjectEntityDetails &object) {
+ if (auto type{AsDynamicType(object.type())}) {
+ TypeAndShape result{std::move(*type)};
+ result.AcquireShape(object);
+ return result;
+ } else {
+ return std::nullopt;
+ }
+}
+
+std::optional<TypeAndShape> TypeAndShape::Characterize(
+ const semantics::ProcEntityDetails &proc) {
+ return Characterize(proc.interface());
+}
+
+std::optional<TypeAndShape> TypeAndShape::Characterize(
+ const semantics::ProcInterface &interface) {
+ if (auto maybeType{Characterize(interface.symbol())}) {
+ return maybeType;
+ } else {
+ return Characterize(interface.type());
+ }
+}
+
+std::optional<TypeAndShape> TypeAndShape::Characterize(
+ const semantics::DeclTypeSpec &spec) {
+ if (auto type{AsDynamicType(spec)}) {
+ return TypeAndShape{std::move(*type)};
+ } else {
+ return std::nullopt;
+ }
+}
+
+std::optional<TypeAndShape> TypeAndShape::Characterize(
+ const semantics::DeclTypeSpec *spec) {
+ if (spec != nullptr) {
+ return Characterize(*spec);
+ } else {
+ return std::nullopt;
}
- o << type.AsFortran();
- if (!shape.empty()) {
+}
+
+void TypeAndShape::AcquireShape(const semantics::ObjectEntityDetails &object) {
+ CHECK(shape_.empty() && !isAssumedRank_);
+ if (object.IsAssumedRank()) {
+ isAssumedRank_ = true;
+ return;
+ }
+ for (const semantics::ShapeSpec &dim : object.shape()) {
+ if (dim.ubound().GetExplicit().has_value()) {
+ Expr<SubscriptInteger> extent{*dim.ubound().GetExplicit()};
+ if (dim.lbound().GetExplicit().has_value()) {
+ extent = std::move(extent) +
+ common::Clone(*dim.lbound().GetExplicit()) -
+ Expr<SubscriptInteger>{1};
+ }
+ shape_.emplace_back(std::move(extent));
+ } else {
+ shape_.push_back(std::nullopt);
+ }
+ }
+}
+
+std::ostream &TypeAndShape::Dump(std::ostream &o) const {
+ o << type_.AsFortran();
+ if (!shape_.empty()) {
+ o << " dimension(";
char sep{'('};
- for (const auto &expr : shape) {
+ for (const auto &expr : shape_) {
o << sep;
sep = ',';
if (expr.has_value()) {
}
}
o << ')';
+ } else if (isAssumedRank_) {
+ o << " dimension(*)";
}
+ return o;
+}
+
+bool DummyDataObject::operator==(const DummyDataObject &that) const {
+ return TypeAndShape::operator==(that) && attrs == that.attrs &&
+ intent == that.intent && coshape == that.coshape;
+}
+
+std::ostream &DummyDataObject::Dump(std::ostream &o) const {
+ attrs.Dump(o, EnumToString);
+ if (intent != common::Intent::Default) {
+ o << "INTENT(" << common::EnumToString(intent) << ')';
+ }
+ TypeAndShape::Dump(o);
if (!coshape.empty()) {
char sep{'['};
for (const auto &expr : coshape) {
return o;
}
+DummyProcedure::DummyProcedure(Procedure &&p)
+ : procedure{new Procedure{std::move(p)}} {}
+
bool DummyProcedure::operator==(const DummyProcedure &that) const {
- return attrs == that.attrs && explicitProcedure == that.explicitProcedure;
+ return attrs == that.attrs && procedure.value() == that.procedure.value();
}
std::ostream &DummyProcedure::Dump(std::ostream &o) const {
attrs.Dump(o, EnumToString);
- explicitProcedure.value().Dump(o);
+ procedure.value().Dump(o);
return o;
}
std::ostream &AlternateReturn::Dump(std::ostream &o) const { return o << '*'; }
+bool IsOptional(const DummyArgument &da) {
+ return std::visit(
+ common::visitors{
+ [](const DummyDataObject &data) {
+ return data.attrs.test(DummyDataObject::Attr::Optional);
+ },
+ [](const DummyProcedure &proc) {
+ return proc.attrs.test(DummyProcedure::Attr::Optional);
+ },
+ [](const AlternateReturn &) { return false; },
+ },
+ da);
+}
+
+FunctionResult::~FunctionResult() = default;
+
bool FunctionResult::operator==(const FunctionResult &that) const {
- return attrs == that.attrs && type == that.type && rank == that.rank;
+ return attrs == that.attrs && u == that.u;
}
std::ostream &FunctionResult::Dump(std::ostream &o) const {
attrs.Dump(o, EnumToString);
- return o << type.AsFortran() << " rank " << rank;
+ std::visit(
+ common::visitors{
+ [&](const TypeAndShape &ts) { ts.Dump(o); },
+ [&](const common::CopyableIndirection<Procedure> &p) {
+ p.value().Dump(o << " procedure(") << ')';
+ },
+ },
+ u);
+ return o;
}
bool Procedure::operator==(const Procedure &that) const {
}
return o << (sep == '(' ? "()" : ")");
}
+
+std::optional<DummyDataObject> DummyDataObject::Characterize(
+ const semantics::Symbol &symbol) {
+ if (const auto *obj{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
+ if (auto type{TypeAndShape::Characterize(*obj)}) {
+ DummyDataObject result{*type};
+ if (symbol.attrs().test(semantics::Attr::OPTIONAL)) {
+ result.attrs.set(DummyDataObject::Attr::Optional);
+ }
+ if (symbol.attrs().test(semantics::Attr::ALLOCATABLE)) {
+ result.attrs.set(DummyDataObject::Attr::Allocatable);
+ }
+ if (symbol.attrs().test(semantics::Attr::ASYNCHRONOUS)) {
+ result.attrs.set(DummyDataObject::Attr::Asynchronous);
+ }
+ if (symbol.attrs().test(semantics::Attr::CONTIGUOUS)) {
+ result.attrs.set(DummyDataObject::Attr::Contiguous);
+ }
+ if (symbol.attrs().test(semantics::Attr::VALUE)) {
+ result.attrs.set(DummyDataObject::Attr::Value);
+ }
+ if (symbol.attrs().test(semantics::Attr::VOLATILE)) {
+ result.attrs.set(DummyDataObject::Attr::Volatile);
+ }
+ if (symbol.attrs().test(semantics::Attr::POINTER)) {
+ result.attrs.set(DummyDataObject::Attr::Pointer);
+ }
+ if (symbol.attrs().test(semantics::Attr::TARGET)) {
+ result.attrs.set(DummyDataObject::Attr::Target);
+ }
+ if (symbol.attrs().test(semantics::Attr::INTENT_IN)) {
+ result.intent = common::Intent::In;
+ }
+ if (symbol.attrs().test(semantics::Attr::INTENT_OUT)) {
+ CHECK(result.intent == common::Intent::Default);
+ result.intent = common::Intent::Out;
+ }
+ if (symbol.attrs().test(semantics::Attr::INTENT_INOUT)) {
+ CHECK(result.intent == common::Intent::Default);
+ result.intent = common::Intent::InOut;
+ }
+ // TODO: acquire coshape when symbol table represents it
+ }
+ }
+ return std::nullopt;
+}
+
+std::optional<DummyProcedure> DummyProcedure::Characterize(
+ const semantics::Symbol &symbol, const IntrinsicProcTable &intrinsics) {
+ if (symbol.has<semantics::ProcEntityDetails>()) {
+ if (auto procedure{Procedure::Characterize(symbol, intrinsics)}) {
+ DummyProcedure result{std::move(procedure.value())};
+ if (symbol.attrs().test(semantics::Attr::OPTIONAL)) {
+ result.attrs.set(DummyProcedure::Attr::Optional);
+ }
+ if (symbol.attrs().test(semantics::Attr::POINTER)) {
+ result.attrs.set(DummyProcedure::Attr::Pointer);
+ }
+ return result;
+ }
+ }
+ return std::nullopt;
+}
+
+std::optional<DummyArgument> CharacterizeDummyArgument(
+ const semantics::Symbol &symbol, const IntrinsicProcTable &intrinsics) {
+ if (auto objCharacteristics{DummyDataObject::Characterize(symbol)}) {
+ return std::move(objCharacteristics.value());
+ } else if (auto procCharacteristics{
+ DummyProcedure::Characterize(symbol, intrinsics)}) {
+ return std::move(procCharacteristics.value());
+ } else {
+ return std::nullopt;
+ }
+}
+
+std::optional<FunctionResult> FunctionResult::Characterize(
+ const Symbol &symbol, const IntrinsicProcTable &intrinsics) {
+ if (const auto *obj{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
+ if (auto type{TypeAndShape::Characterize(*obj)}) {
+ FunctionResult result{std::move(*type)};
+ if (symbol.attrs().test(semantics::Attr::ALLOCATABLE)) {
+ result.attrs.set(FunctionResult::Attr::Pointer);
+ }
+ if (symbol.attrs().test(semantics::Attr::CONTIGUOUS)) {
+ result.attrs.set(FunctionResult::Attr::Contiguous);
+ }
+ if (symbol.attrs().test(semantics::Attr::POINTER)) {
+ result.attrs.set(FunctionResult::Attr::Pointer);
+ }
+ return result;
+ }
+ } else if (auto maybeProc{Procedure::Characterize(symbol, intrinsics)}) {
+ FunctionResult result{std::move(*maybeProc)};
+ result.attrs.set(FunctionResult::Attr::Pointer);
+ return result;
+ }
+ return std::nullopt;
+}
+
+bool FunctionResult::IsAssumedLengthCharacter() const {
+ if (const auto *ts{std::get_if<TypeAndShape>(&u)}) {
+ return ts->type().IsAssumedLengthCharacter();
+ } else {
+ return false;
+ }
+}
+
+static void SetProcedureAttrs(
+ Procedure &procedure, const semantics::Symbol &symbol) {
+ if (symbol.attrs().test(semantics::Attr::PURE)) {
+ procedure.attrs.set(Procedure::Attr::Pure);
+ }
+ if (symbol.attrs().test(semantics::Attr::ELEMENTAL)) {
+ procedure.attrs.set(Procedure::Attr::Elemental);
+ }
+ if (symbol.attrs().test(semantics::Attr::BIND_C)) {
+ procedure.attrs.set(Procedure::Attr::BindC);
+ }
+}
+
+std::optional<Procedure> Procedure::Characterize(
+ const semantics::Symbol &symbol, const IntrinsicProcTable &intrinsics) {
+ Procedure result;
+ if (const auto *subp{symbol.detailsIf<semantics::SubprogramDetails>()}) {
+ if (subp->isFunction()) {
+ if (auto maybeResult{
+ FunctionResult::Characterize(subp->result(), intrinsics)}) {
+ result.functionResult = std::move(maybeResult);
+ } else {
+ return std::nullopt;
+ }
+ }
+ SetProcedureAttrs(result, symbol);
+ for (const semantics::Symbol *arg : subp->dummyArgs()) {
+ if (arg == nullptr) {
+ result.dummyArguments.emplace_back(AlternateReturn{});
+ } else if (auto argCharacteristics{
+ CharacterizeDummyArgument(*arg, intrinsics)}) {
+ result.dummyArguments.emplace_back(
+ std::move(argCharacteristics.value()));
+ } else {
+ return std::nullopt;
+ }
+ }
+ return std::move(result);
+ } else if (const auto *proc{
+ symbol.detailsIf<semantics::ProcEntityDetails>()}) {
+ const semantics::ProcInterface &interface{proc->interface()};
+ Procedure result;
+ if (const semantics::Symbol * interfaceSymbol{interface.symbol()}) {
+ if (auto characterized{Characterize(*interfaceSymbol, intrinsics)}) {
+ result = *characterized;
+ } else {
+ return std::nullopt;
+ }
+ } else {
+ result.attrs.set(Procedure::Attr::ImplicitInterface);
+ if (const semantics::DeclTypeSpec * type{interface.type()}) {
+ if (auto resultType{AsDynamicType(*type)}) {
+ result.functionResult = FunctionResult{*resultType};
+ } else {
+ return std::nullopt;
+ }
+ } else {
+ // subroutine, not function
+ }
+ }
+ SetProcedureAttrs(result, symbol);
+ // The PASS name, if any, is not a characteristic.
+ } else if (const auto *misc{symbol.detailsIf<semantics::MiscDetails>()}) {
+ if (misc->kind() == semantics::MiscDetails::Kind::SpecificIntrinsic) {
+ if (auto intrinsic{intrinsics.IsUnrestrictedSpecificIntrinsicFunction(
+ symbol.name().ToString())}) {
+ return *intrinsic;
+ }
+ }
+ }
+ return std::nullopt;
+}
DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(DummyProcedure)
+DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(FunctionResult)
+DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(Procedure)
}
-DEFINE_DELETER(Fortran::evaluate::characteristics::Procedure)
+template class Fortran::common::Indirection<
+ Fortran::evaluate::characteristics::Procedure, true>;
#include "../common/enum-set.h"
#include "../common/idioms.h"
#include "../common/indirection.h"
-#include <memory>
+#include "../semantics/symbol.h"
+#include <optional>
#include <ostream>
#include <variant>
#include <vector>
+namespace Fortran::evaluate {
+class IntrinsicProcTable;
+}
namespace Fortran::evaluate::characteristics {
-
-// Forward declare Procedure so dummy procedures can use it indirectly
struct Procedure;
+}
+extern template class Fortran::common::Indirection<
+ Fortran::evaluate::characteristics::Procedure, true>;
+
+namespace Fortran::evaluate::characteristics {
+
+// Absent components are deferred or assumed.
+using Shape = std::vector<std::optional<Expr<SubscriptInteger>>>;
+
+class TypeAndShape {
+public:
+ explicit TypeAndShape(DynamicType t) : type_{t} {}
+ DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(TypeAndShape)
+
+ DynamicType type() const { return type_; }
+ const Shape &shape() const { return shape_; }
+ bool IsAssumedRank() const { return isAssumedRank_; }
+
+ bool operator==(const TypeAndShape &) const;
+
+ static std::optional<TypeAndShape> Characterize(const semantics::Symbol &);
+ static std::optional<TypeAndShape> Characterize(const semantics::Symbol *);
+ static std::optional<TypeAndShape> Characterize(
+ const semantics::ObjectEntityDetails &);
+ static std::optional<TypeAndShape> Characterize(
+ const semantics::ProcEntityDetails &);
+ static std::optional<TypeAndShape> Characterize(
+ const semantics::ProcInterface &);
+ static std::optional<TypeAndShape> Characterize(
+ const semantics::DeclTypeSpec &);
+ static std::optional<TypeAndShape> Characterize(
+ const semantics::DeclTypeSpec *);
+
+ std::ostream &Dump(std::ostream &) const;
+
+private:
+ void AcquireShape(const semantics::ObjectEntityDetails &);
+
+protected:
+ DynamicType type_;
+ Shape shape_;
+ bool isAssumedRank_{false};
+};
// 15.3.2.2
-struct DummyDataObject {
- ENUM_CLASS(Attr, AssumedRank, Optional, Allocatable, Asynchronous, Contiguous,
- Value, Volatile, Polymorphic, Pointer, Target)
+struct DummyDataObject : public TypeAndShape {
+ ENUM_CLASS(Attr, Optional, Allocatable, Asynchronous, Contiguous, Value,
+ Volatile, Pointer, Target)
DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(DummyDataObject)
- DynamicType type;
- std::vector<std::optional<Expr<SubscriptInteger>>> shape;
+ explicit DummyDataObject(const TypeAndShape &t) : TypeAndShape{t} {}
+ explicit DummyDataObject(TypeAndShape &&t) : TypeAndShape{std::move(t)} {}
+ explicit DummyDataObject(DynamicType t) : TypeAndShape{t} {}
+ bool operator==(const DummyDataObject &) const;
+ static std::optional<DummyDataObject> Characterize(const semantics::Symbol &);
+ std::ostream &Dump(std::ostream &) const;
std::vector<Expr<SubscriptInteger>> coshape;
common::Intent intent{common::Intent::Default};
common::EnumSet<Attr, 32> attrs;
- bool operator==(const DummyDataObject &) const;
- std::ostream &Dump(std::ostream &) const;
};
// 15.3.2.3
struct DummyProcedure {
ENUM_CLASS(Attr, Pointer, Optional)
DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(DummyProcedure)
- common::CopyableIndirection<Procedure> explicitProcedure;
- common::EnumSet<Attr, 32> attrs;
+ explicit DummyProcedure(Procedure &&);
bool operator==(const DummyProcedure &) const;
+ static std::optional<DummyProcedure> Characterize(
+ const semantics::Symbol &, const IntrinsicProcTable &);
std::ostream &Dump(std::ostream &) const;
+ common::CopyableIndirection<Procedure> procedure;
+ common::EnumSet<Attr, 32> attrs;
};
// 15.3.2.4
// 15.3.2.1
using DummyArgument =
std::variant<DummyDataObject, DummyProcedure, AlternateReturn>;
+bool IsOptional(const DummyArgument &);
+std::optional<DummyArgument> CharacterizeDummyArgument(
+ const semantics::Symbol &, const IntrinsicProcTable &);
// 15.3.3
struct FunctionResult {
- ENUM_CLASS(
- Attr, Polymorphic, Allocatable, Pointer, Contiguous, ProcedurePointer)
- DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(FunctionResult)
- DynamicType type;
- int rank{0};
- common::EnumSet<Attr, 32> attrs;
+ ENUM_CLASS(Attr, Allocatable, Pointer, Contiguous)
+ DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(FunctionResult)
+ explicit FunctionResult(DynamicType t) : u{TypeAndShape{t}} {}
+ explicit FunctionResult(TypeAndShape &&t) : u{std::move(t)} {}
+ explicit FunctionResult(Procedure &&p) : u{std::move(p)} {}
+ ~FunctionResult();
bool operator==(const FunctionResult &) const;
+ static std::optional<FunctionResult> Characterize(
+ const Symbol &, const IntrinsicProcTable &);
+
+ bool IsAssumedLengthCharacter() const;
+
+ const Procedure *IsProcedurePointer() const {
+ if (const auto *pp{
+ std::get_if<common::CopyableIndirection<Procedure>>(&u)}) {
+ return &pp->value();
+ } else {
+ return nullptr;
+ }
+ }
std::ostream &Dump(std::ostream &) const;
+
+ common::EnumSet<Attr, 32> attrs;
+ std::variant<TypeAndShape, common::CopyableIndirection<Procedure>> u;
};
// 15.3.1
struct Procedure {
- ENUM_CLASS(Attr, Pure, Elemental, Bind_C)
+ ENUM_CLASS(Attr, Pure, Elemental, BindC, ImplicitInterface)
Procedure() {}
- DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(Procedure)
- std::optional<FunctionResult> functionResult; // absent means subroutine
- std::vector<DummyArgument> dummyArguments;
- common::EnumSet<Attr, 32> attrs;
+ DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(Procedure)
bool operator==(const Procedure &) const;
+
+ static std::optional<Procedure> Characterize(
+ const semantics::Symbol &, const IntrinsicProcTable &);
+ bool IsFunction() const { return functionResult.has_value(); }
+ bool IsSubroutine() const { return !IsFunction(); }
+ bool IsPure() const { return attrs.test(Attr::Pure); }
+ bool IsElemental() const { return attrs.test(Attr::Elemental); }
+ bool IsBindC() const { return attrs.test(Attr::BindC); }
+ bool HasExplicitInterface() const {
+ return !attrs.test(Attr::ImplicitInterface);
+ }
std::ostream &Dump(std::ostream &) const;
+
+ std::optional<FunctionResult> functionResult;
+ std::vector<DummyArgument> dummyArguments;
+ common::EnumSet<Attr, 32> attrs;
};
}
#endif // FORTRAN_EVALUATE_CHARACTERISTICS_H_
#include <variant>
namespace Fortran::semantics {
+class DeclTypeSpec;
class DerivedTypeSpec;
class ParamValue;
class Symbol;
constexpr DynamicType(TypeCategory cat, int k) : category{cat}, kind{k} {}
constexpr DynamicType(int k, const semantics::ParamValue &pv)
: category{TypeCategory::Character}, kind{k}, charLength{&pv} {}
- explicit constexpr DynamicType(const semantics::DerivedTypeSpec &dt)
- : category{TypeCategory::Derived}, derived{&dt} {}
+ explicit constexpr DynamicType(
+ const semantics::DerivedTypeSpec &dt, bool poly = false)
+ : category{TypeCategory::Derived}, derived{&dt}, isPolymorphic{poly} {}
+ // Comparison is deep -- type parameters are compared independently.
bool operator==(const DynamicType &) const;
+ bool operator!=(const DynamicType &that) const { return !(*this == that); }
+
std::string AsFortran() const;
std::string AsFortran(std::string &&charLenExpr) const;
DynamicType ResultTypeForMultiply(const DynamicType &) const;
+ bool IsAssumedLengthCharacter() const;
TypeCategory category{TypeCategory::Integer}; // overridable default
int kind{0}; // set only for intrinsic types
const semantics::ParamValue *charLength{nullptr};
const semantics::DerivedTypeSpec *derived{nullptr}; // TYPE(T), CLASS(T)
+ bool isPolymorphic{false}; // CLASS(T), CLASS(*)
};
// Result will be missing when a symbol is absent or
// has an erroneous type, e.g., REAL(KIND=666).
+std::optional<DynamicType> AsDynamicType(const semantics::DeclTypeSpec &);
+std::optional<DynamicType> AsDynamicType(const semantics::DeclTypeSpec *);
std::optional<DynamicType> GetSymbolType(const semantics::Symbol &);
std::optional<DynamicType> GetSymbolType(const semantics::Symbol *);
constexpr bool operator==(const SomeKind &) const { return true; }
};
+using AllGenericIntrinsicCategoryTypes =
+ std::tuple<SomeKind<TypeCategory::Integer>, SomeKind<TypeCategory::Real>,
+ SomeKind<TypeCategory::Complex>, SomeKind<TypeCategory::Character>,
+ SomeKind<TypeCategory::Logical>>;
+template<typename T>
+constexpr bool IsGenericIntrinsicCategoryType{
+ common::HasMember<T, AllGenericIntrinsicCategoryTypes>};
+
// Represents a completely generic type (but not typeless).
struct SomeType {};
projects / platform / upstream / llvm.git / commitdiff