if (intent != common::Intent::Default) {
o << "INTENT(" << common::EnumToString(intent) << ')';
}
- // TODO pmk WIP: generalize this too
- if (type.category == common::TypeCategory::Character) {
- if (characterLength.get() == nullptr) {
- o << type.AsFortran(":"s);
- } else {
- std::stringstream ss;
- characterLength->AsFortran(ss);
- o << type.AsFortran(ss.str());
- }
- } else {
- o << type.AsFortran();
- }
+ o << type.AsFortran();
if (!shape.empty()) {
char sep{'('};
for (const auto &expr : shape) {
std::ostream &FunctionResult::Dump(std::ostream &o) const {
attrs.Dump(o, EnumToString);
- if (type.category == TypeCategory::Character) {
- if (characterLength.get() == nullptr) {
- o << type.AsFortran("*"s);
- } else {
- std::stringstream ss;
- characterLength->AsFortran(o);
- o << type.AsFortran(ss.str());
- }
- } else {
- o << type.AsFortran();
- }
- return o << " rank " << rank;
+ return o << type.AsFortran() << " rank " << rank;
}
bool Procedure::operator==(const Procedure &that) const {
#include "expression.h"
#include "type.h"
+#include "../common/enum-set.h"
#include "../common/fortran.h"
#include "../common/idioms.h"
#include "../common/indirection.h"
-#include "../common/enum-set.h"
#include <memory>
#include <ostream>
#include <variant>
// 15.3.2.2
struct DummyDataObject {
- ENUM_CLASS(Attr, AssumedRank, Optional, Allocatable, Asynchronous,
- Contiguous, Value, Volatile, Polymorphic, Pointer, Target)
+ ENUM_CLASS(Attr, AssumedRank, Optional, Allocatable, Asynchronous, Contiguous,
+ Value, Volatile, Polymorphic, Pointer, Target)
DynamicType type;
- std::unique_ptr<Expr<SubscriptInteger>> characterLength;
std::vector<std::optional<Expr<SubscriptInteger>>> shape;
std::vector<Expr<SubscriptInteger>> coshape;
common::Intent intent{common::Intent::Default};
};
// 15.3.2.1
-using DummyArgument = std::variant<DummyDataObject, DummyProcedure, AlternateReturn>;
+using DummyArgument =
+ std::variant<DummyDataObject, DummyProcedure, AlternateReturn>;
// 15.3.3
struct FunctionResult {
- ENUM_CLASS(Attr, Polymorphic, Allocatable, Pointer, Contiguous,
- ProcedurePointer)
+ ENUM_CLASS(
+ Attr, Polymorphic, Allocatable, Pointer, Contiguous, ProcedurePointer)
DynamicType type;
- std::unique_ptr<Expr<SubscriptInteger>> characterLength;
int rank{0};
common::EnumSet<Attr, 32> attrs;
bool operator==(const FunctionResult &) const;
return *derivedTypeSpec_;
}
- DynamicType GetType() const {
- return DynamicType{TypeCategory::Derived, 0, derivedTypeSpec_};
- }
+ DynamicType GetType() const { return DynamicType{derivedTypeSpec()}; }
private:
const semantics::DerivedTypeSpec *derivedTypeSpec_;
}
DynamicType StructureConstructor::GetType() const {
- return {TypeCategory::Derived, 0, derivedTypeSpec_};
+ return DynamicType{*derivedTypeSpec_};
}
StructureConstructor &StructureConstructor::Add(
const semantics::DerivedTypeSpec &derivedTypeSpec() const {
return *derivedTypeSpec_;
}
- DynamicType GetType() const {
- return DynamicType{TypeCategory::Derived, 0, derivedTypeSpec_};
- }
+ DynamicType GetType() const { return DynamicType{derivedTypeSpec()}; }
std::ostream &AsFortran(std::ostream &) const;
private:
if (value->isExplicit()) {
return Fold(context,
Expr<IntKIND>{Convert<IntKIND, TypeCategory::Integer>(
- value->GetExplicit().value())});
+ Expr<SomeInteger>{value->GetExplicit().value()})});
}
}
}
bool DynamicType::operator==(const DynamicType &that) const {
return category == that.category && kind == that.kind &&
- derived == that.derived;
+ charLength == that.charLength && derived == that.derived;
}
std::optional<DynamicType> GetSymbolType(const semantics::Symbol *symbol) {
if (auto kind{ToInt64(intrinsic->kind())}) {
TypeCategory category{intrinsic->category()};
if (IsValidKindOfIntrinsicType(category, *kind)) {
- return DynamicType{category, static_cast<int>(*kind)};
+ if (category == TypeCategory::Character) {
+ const auto &charType{type->characterTypeSpec()};
+ return DynamicType{static_cast<int>(*kind), charType.length()};
+ } else {
+ return DynamicType{category, static_cast<int>(*kind)};
+ }
}
}
} else if (const auto *derived{type->AsDerived()}) {
- return DynamicType{TypeCategory::Derived, 0, derived};
+ return DynamicType{*derived};
}
}
}
if (derived != nullptr) {
CHECK(category == TypeCategory::Derived);
return "TYPE("s + derived->typeSymbol().name().ToString() + ')';
+ } else if (charLength != nullptr) {
+ std::string result{"CHARACTER(KIND="s + std::to_string(kind) + ",LEN="};
+ if (charLength->isAssumed()) {
+ result += ",LEN=*";
+ } else if (charLength->isDeferred()) {
+ result += ",LEN=:";
+ } else if (const auto &length{charLength->GetExplicit()}) {
+ std::stringstream ss;
+ length->AsFortran(ss << ",LEN=");
+ result += ss.str();
+ }
+ return result + ')';
} else {
return EnumToString(category) + '(' + std::to_string(kind) + ')';
}
std::string DynamicType::AsFortran(std::string &&charLenExpr) const {
if (!charLenExpr.empty() && category == TypeCategory::Character) {
return "CHARACTER(KIND=" + std::to_string(kind) +
- ",len=" + std::move(charLenExpr) + ')';
+ ",LEN=" + std::move(charLenExpr) + ')';
} else {
return AsFortran();
}
namespace Fortran::semantics {
class DerivedTypeSpec;
+class ParamValue;
class Symbol;
bool IsDescriptor(const Symbol &);
}
using LogicalResult = Type<TypeCategory::Logical, 1>;
using LargestReal = Type<TypeCategory::Real, 16>;
-// DynamicType is suitable for use as the result type for
-// GetType() functions and member functions; consequently,
-// it must be capable of being used in a constexpr context.
-// So it does *not* hold anything requiring a destructor,
-// such as a CHARACTER length type parameter expression.
-// Those must be derived via LEN() member functions or packaged
-// elsewhere (e.g. as in ArrayConstructor).
+// DynamicType is meant to be suitable for use as the result type for
+// GetType() functions and member functions; consequently, it must be
+// capable of being used in a constexpr context. So it does *not*
+// directly hold anything requiring a destructor, such as an arbitrary
+// CHARACTER length type parameter expression. Those must be derived
+// via LEN() member functions, packaged elsewhere (e.g. as in
+// ArrayConstructor), or copied from a parameter spec in the symbol table
+// if one is supplied.
struct DynamicType {
+ constexpr DynamicType() = default;
+ 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} {}
+
bool operator==(const DynamicType &) const;
std::string AsFortran() const;
std::string AsFortran(std::string &&charLenExpr) const;
DynamicType ResultTypeForMultiply(const DynamicType &) const;
- TypeCategory category;
+ 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)
};
CLASS_BOILERPLATE(SomeKind)
explicit SomeKind(const semantics::DerivedTypeSpec &dts) : spec_{&dts} {}
- DynamicType GetType() const { return DynamicType{category, 0, spec_}; }
+ DynamicType GetType() const { return DynamicType{spec()}; }
const semantics::DerivedTypeSpec &spec() const { return *spec_; }
bool operator==(const SomeKind &) const;
std::string AsFortran() const;
};
struct DynamicTypeWithLength : public DynamicType {
+ std::optional<Expr<SubscriptInteger>> LEN() const;
std::optional<Expr<SubscriptInteger>> length;
};
+std::optional<Expr<SubscriptInteger>> DynamicTypeWithLength::LEN() const {
+ if (length.has_value()) {
+ return length;
+ }
+ if (charLength != nullptr) {
+ if (const auto &len{charLength->GetExplicit()}) {
+ return ConvertToType<SubscriptInteger>(common::Clone(*len));
+ }
+ }
+ return std::nullopt;
+}
+
std::optional<DynamicTypeWithLength> AnalyzeTypeSpec(
ExpressionAnalysisContext &context,
const std::optional<parser::TypeSpec> &spec) {
if (const semantics::IntrinsicTypeSpec *
intrinsic{typeSpec->AsIntrinsic()}) {
TypeCategory category{intrinsic->category()};
- if (auto kind{ToInt64(intrinsic->kind())}) {
- DynamicTypeWithLength result{{category, static_cast<int>(*kind)}};
+ if (auto optKind{ToInt64(intrinsic->kind())}) {
+ int kind{static_cast<int>(*optKind)};
if (category == TypeCategory::Character) {
const semantics::CharacterTypeSpec &cts{
typeSpec->characterTypeSpec()};
- const semantics::ParamValue len{cts.length()};
+ const semantics::ParamValue &len{cts.length()};
// N.B. CHARACTER(LEN=*) is allowed in type-specs in ALLOCATE() &
// type guards, but not in array constructors.
- if (len.GetExplicit().has_value()) {
- Expr<SomeInteger> copy{*len.GetExplicit()};
- result.length = ConvertToType<SubscriptInteger>(std::move(copy));
- }
+ return DynamicTypeWithLength{DynamicType{kind, len}};
+ } else {
+ return DynamicTypeWithLength{DynamicType{category, kind}};
}
- return result;
}
} else if (const semantics::DerivedTypeSpec *
derived{typeSpec->AsDerived()}) {
- return DynamicTypeWithLength{{TypeCategory::Derived, 0, derived}};
+ return DynamicTypeWithLength{DynamicType{*derived}};
}
}
}
if (static_cast<const DynamicType &>(*type_) ==
static_cast<const DynamicType &>(xType)) {
values_.Push(std::move(*x));
- if (auto thisLen{ToInt64(xType.length)}) {
+ if (auto thisLen{ToInt64(xType.LEN())}) {
if (constantLength_.has_value()) {
if (exprContext_.context().warnOnNonstandardUsage() &&
*thisLen != *constantLength_) {
// length of the array constructor's character elements, not the
// first, when there is no explicit type.
*constantLength_ = *thisLen;
- type_->length = std::move(xType.length);
+ type_->length = xType.LEN();
}
} else {
constantLength_ = *thisLen;
- type_->length = std::move(xType.length);
+ type_->length = xType.LEN();
}
}
} else {
*type.derived, MakeSpecific<T>(std::move(values))});
} else if (type.kind == T::kind) {
if constexpr (T::category == TypeCategory::Character) {
- CHECK(type.length.has_value());
return AsMaybeExpr(ArrayConstructor<T>{
- std::move(*type.length), MakeSpecific<T>(std::move(values))});
+ type.LEN().value(), MakeSpecific<T>(std::move(values))});
} else {
return AsMaybeExpr(
ArrayConstructor<T>{MakeSpecific<T>(std::move(values))});