class DerivedTypeSpec;
}
-namespace Fortran::semantics {
-class DerivedTypeSpec;
-}
-
namespace Fortran::evaluate {
using common::RelationalOperator;
// limitations under the License.
#include "constant.h"
+#include "expression.h"
#include "type.h"
#include "../parser/characters.h"
namespace Fortran::evaluate {
+
+template<typename T> ConstantBase<T>::~ConstantBase() {}
+
template<typename T>
-std::ostream &Constant<T>::AsFortran(std::ostream &o) const {
+std::ostream &ConstantBase<T>::AsFortran(std::ostream &o) const {
if (Rank() > 1) {
o << "reshape(";
}
}
o << '_' << Result::kind;
} else {
- value.u.AsFortran(o);
+ value.AsFortran(o);
}
}
if (Rank() > 0) {
}
template<typename T>
-auto Constant<T>::At(const std::vector<std::int64_t> &index) const -> Value {
+auto ConstantBase<T>::At(const std::vector<std::int64_t> &index) const
+ -> Value {
CHECK(index.size() == static_cast<std::size_t>(Rank()));
std::int64_t stride{1}, offset{0};
int dim{0};
return values_.at(offset);
}
-template<typename T> Constant<SubscriptInteger> Constant<T>::SHAPE() const {
+template<typename T> Constant<SubscriptInteger> ConstantBase<T>::SHAPE() const {
using IntType = Scalar<SubscriptInteger>;
std::vector<IntType> result;
for (std::int64_t dim : shape_) {
return {std::move(result), std::vector<std::int64_t>{Rank()}};
}
+Constant<SomeDerived>::Constant(const semantics::DerivedTypeSpec &spec,
+ std::vector<StructureConstructor> &&x, std::vector<std::int64_t> &&s)
+ : Base{std::move(x), std::move(s)}, spec_{&spec} {}
+
+FOR_EACH_SPECIFIC_TYPE(template class ConstantBase)
FOR_EACH_INTRINSIC_KIND(template class Constant)
}
// N.B. Generic constants are represented by generic expressions
// (like Expr<SomeInteger> & Expr<SomeType>) wrapping the appropriate
// instantiations of Constant.
-template<typename T> class Constant {
- static_assert(std::is_same_v<T, SomeDerived> || IsSpecificIntrinsicType<T>);
+template<typename> class Constant;
+
+template<typename RESULT> class ConstantBase {
public:
- using Result = T;
+ using Result = RESULT;
using Value = Scalar<Result>;
- CLASS_BOILERPLATE(Constant)
- template<typename A> Constant(const A &x) : values_{x} {}
+ template<typename A> ConstantBase(const A &x) : values_{x} {}
template<typename A>
- Constant(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
+ ConstantBase(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
: values_{std::move(x)} {}
- Constant(std::vector<Value> &&x, std::vector<std::int64_t> &&s)
+ ConstantBase(std::vector<Value> &&x, std::vector<std::int64_t> &&s)
: values_(std::move(x)), shape_(std::move(s)) {}
+ ~ConstantBase();
- constexpr DynamicType GetType() const { return Result::GetType(); }
int Rank() const { return static_cast<int>(shape_.size()); }
- bool operator==(const Constant &that) const {
+ bool operator==(const ConstantBase &that) const {
return shape_ == that.shape_ && values_ == that.values_;
}
bool empty() const { return values_.empty(); }
Constant<SubscriptInteger> SHAPE() const;
std::ostream &AsFortran(std::ostream &) const;
-private:
+protected:
std::vector<Value> values_;
std::vector<std::int64_t> shape_;
- // TODO pmk: make CHARACTER values contiguous (they're strings now)
+
+private:
+ const Constant<Result> &AsConstant() const {
+ return *static_cast<const Constant<Result> *>(this);
+ }
+
+ DynamicType GetType() const { return AsConstant().GetType(); }
+};
+
+template<typename T> class Constant : public ConstantBase<T> {
+public:
+ using Result = T;
+ using ConstantBase<Result>::ConstantBase;
+ CLASS_BOILERPLATE(Constant)
+ static constexpr DynamicType GetType() { return Result::GetType(); }
};
-// Would prefer to have this be a member function of Constant enabled
-// only for CHARACTER, but std::enable_if<> isn't effective in that context.
template<int KIND>
-std::int64_t ConstantLEN(
- const Constant<Type<TypeCategory::Character, KIND>> &c) {
- if (c.empty()) {
- return 0;
- } else {
- std::vector<std::int64_t> ones(c.Rank(), 1);
- return c.At(ones).size();
+class Constant<Type<TypeCategory::Character, KIND>>
+ : public ConstantBase<Type<TypeCategory::Character, KIND>> {
+public:
+ using Result = Type<TypeCategory::Character, KIND>;
+ using ConstantBase<Result>::ConstantBase;
+ CLASS_BOILERPLATE(Constant)
+ static constexpr DynamicType GetType() { return Result::GetType(); }
+ std::int64_t LEN() const {
+ if (this->values_.empty()) {
+ return 0;
+ } else {
+ return static_cast<std::int64_t>(this->values_.front().size());
+ }
}
-}
+ // TODO pmk: make CHARACTER values contiguous (they're strings now)
+};
+
+template<> class Constant<SomeDerived> : public ConstantBase<SomeDerived> {
+public:
+ using Result = SomeDerived;
+ using Base = ConstantBase<Result>;
+ template<typename A>
+ Constant(const semantics::DerivedTypeSpec &spec, const A &x)
+ : Base{x}, spec_{&spec} {}
+ template<typename A>
+ Constant(const semantics::DerivedTypeSpec &spec,
+ std::enable_if_t<!std::is_reference_v<A>, A> &&x)
+ : Base{std::move(x)}, spec_{&spec} {}
+ Constant(const semantics::DerivedTypeSpec &, std::vector<Value> &&,
+ std::vector<std::int64_t> &&);
+
+ CLASS_BOILERPLATE(Constant)
+ DynamicType GetType() const {
+ return DynamicType{TypeCategory::Derived, 0, spec_};
+ }
+
+private:
+ const semantics::DerivedTypeSpec *spec_;
+};
+FOR_EACH_SPECIFIC_TYPE(extern template class ConstantBase)
FOR_EACH_INTRINSIC_KIND(extern template class Constant)
}
#endif // FORTRAN_EVALUATE_CONSTANT_H_
return std::visit(
common::visitors{
[](const Constant<Result> &c) {
- return AsExpr(Constant<SubscriptInteger>{ConstantLEN(c)});
+ return AsExpr(Constant<SubscriptInteger>{c.LEN()});
},
[](const ArrayConstructor<Result> &a) { return a.LEN(); },
[](const Parentheses<Result> &x) { return x.left().LEN(); },
FOR_EACH_LOGICAL_KIND(extern template class Expr)
+class StructureConstructor {
+public:
+ using Values = std::list<std::pair<const semantics::Symbol *,
+ CopyableIndirection<Expr<SomeType>>>>;
+
+ // N.B. CLASS_BOILERPLATE() can't be used here due to forward reference
+ // to Expr<SomeType> preventing the use of "= default" constructors and
+ // assignment operators.
+ StructureConstructor() = delete;
+ explicit StructureConstructor(const semantics::DerivedTypeSpec &spec)
+ : derivedTypeSpec_{&spec} {}
+ StructureConstructor(const StructureConstructor &);
+ StructureConstructor(StructureConstructor &&);
+ ~StructureConstructor();
+ StructureConstructor &operator=(const StructureConstructor &);
+ StructureConstructor &operator=(StructureConstructor &&);
+
+ const semantics::DerivedTypeSpec &derivedTypeSpec() const {
+ return *derivedTypeSpec_;
+ }
+ Values &values() { return values_; }
+ const Values &values() const { return values_; }
+ bool operator==(const StructureConstructor &) const;
+
+ StructureConstructor &Add(const semantics::Symbol &, Expr<SomeType> &&);
+ int Rank() const { return 0; }
+ DynamicType GetType() const;
+ std::ostream &AsFortran(std::ostream &) const;
+
+private:
+ const semantics::DerivedTypeSpec *derivedTypeSpec_;
+ Values values_;
+};
+
// An expression whose result has a derived type.
template<> class Expr<SomeDerived> : public ExpressionBase<SomeDerived> {
public:
using Result = SomeDerived;
EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
- // TODO: structure constructor
- std::variant<Designator<Result>, ArrayConstructor<Result>,
- FunctionRef<Result>>
+ std::variant<Constant<Result>, ArrayConstructor<Result>, StructureConstructor,
+ Designator<Result>, FunctionRef<Result>>
u;
};
FoldingContext &, TypeParamInquiry<KIND> &&);
template<typename T>
Expr<T> FoldOperation(FoldingContext &, ArrayConstructor<T> &&);
+Expr<SomeDerived> FoldOperation(FoldingContext &, StructureConstructor &&);
// Overloads, instantiations, and specializations of FoldOperation().
Expr<T> FoldArray(ArrayConstructor<T> &&array) {
if (FoldArray(array.values)) {
std::int64_t n = elements_.size();
- Expr<T> result{
- Constant<T>{std::move(elements_), std::vector<std::int64_t>{n}}};
- return result;
+ if constexpr (std::is_same_v<T, SomeDerived>) {
+ return Expr<T>{Constant<T>{array.type.spec(), std::move(elements_),
+ std::vector<std::int64_t>{n}}};
+ } else {
+ return Expr<T>{
+ Constant<T>{std::move(elements_), std::vector<std::int64_t>{n}}};
+ }
} else {
return Expr<T>{std::move(array)};
}
return result;
}
-// TODO this specialization is a placeholder: don't fold array constructors
-// of derived type for now
Expr<SomeDerived> FoldOperation(
- FoldingContext &context, ArrayConstructor<SomeDerived> &&array) {
- return Expr<SomeDerived>{std::move(array)};
+ FoldingContext &context, StructureConstructor &&structure) {
+ StructureConstructor result{structure.derivedTypeSpec()};
+ for (auto &&[symbol, value] : std::move(structure.values())) {
+ result.Add(*symbol, Fold(context, std::move(*value)));
+ }
+ return Expr<SomeDerived>{
+ Constant<SomeDerived>{result.derivedTypeSpec(), result}};
}
// Substitute a bare type parameter reference with its value if it has one now
bool IsConstExpr(ConstExprContext &, const ArrayConstructorValues<A> &);
template<typename A>
bool IsConstExpr(ConstExprContext &, const ArrayConstructor<A> &);
+bool IsConstExpr(ConstExprContext &, const semantics::DerivedTypeSpec &);
+bool IsConstExpr(ConstExprContext &, const StructureConstructor &);
bool IsConstExpr(ConstExprContext &, const BaseObject &);
bool IsConstExpr(ConstExprContext &, const Component &);
bool IsConstExpr(ConstExprContext &, const Triplet &);
bool IsConstExpr(ConstExprContext &context, const ArrayConstructor<A> &array) {
return IsConstExpr(context, array.values);
}
+bool IsConstExpr(
+ ConstExprContext &context, const semantics::DerivedTypeSpec &spec) {
+ for (const auto &nameValue : spec.parameters()) {
+ const auto &value{nameValue.second};
+ if (!value.isExplicit() || !value.GetExplicit().has_value() ||
+ !IsConstExpr(context, *value.GetExplicit())) {
+ return false;
+ }
+ }
+ return true;
+}
+bool IsConstExpr(
+ ConstExprContext &context, const StructureConstructor &structure) {
+ if (!IsConstExpr(context, structure.derivedTypeSpec())) {
+ return false;
+ }
+ for (const auto &symbolExpr : structure.values()) {
+ if (!IsConstExpr(context, symbolExpr.second)) {
+ return false;
+ }
+ }
+ return true;
+}
bool IsConstExpr(ConstExprContext &context, const BaseObject &base) {
return IsConstExpr(context, base.u);
}
// limitations under the License.
#include "type.h"
+#include "expression.h"
#include "fold.h"
#include "../common/idioms.h"
#include "../semantics/scope.h"
#include "../semantics/type.h"
#include <algorithm>
#include <optional>
+#include <ostream>
+#include <sstream>
#include <string>
using namespace std::literals::string_literals;
return spec_ == that.spec_ && descriptor_ == that.descriptor_;
}
+static std::ostream &DerivedTypeSpecAsFortran(
+ std::ostream &o, const semantics::DerivedTypeSpec &spec) {
+ o << "TYPE("s << spec.typeSymbol().name().ToString();
+ if (!spec.parameters().empty()) {
+ char ch{'('};
+ for (const auto &[name, value] : spec.parameters()) {
+ value.GetExplicit()->AsFortran(o << ch << name.ToString() << '=');
+ ch = ',';
+ }
+ o << ')';
+ }
+ return o;
+}
+
std::string SomeDerived::AsFortran() const {
- return "TYPE("s + spec().typeSymbol().name().ToString() + ')';
+ std::stringstream out;
+ DerivedTypeSpecAsFortran(out, spec());
+ return out.str();
+}
+
+StructureConstructor::StructureConstructor(const StructureConstructor &that)
+ : derivedTypeSpec_{that.derivedTypeSpec_}, values_{that.values_} {}
+StructureConstructor::StructureConstructor(StructureConstructor &&that)
+ : derivedTypeSpec_{that.derivedTypeSpec_}, values_{std::move(that.values_)} {}
+StructureConstructor::~StructureConstructor() {}
+StructureConstructor &StructureConstructor::operator=(
+ const StructureConstructor &that) {
+ derivedTypeSpec_ = that.derivedTypeSpec_;
+ values_ = that.values_;
+ return *this;
+}
+StructureConstructor &StructureConstructor::operator=(
+ StructureConstructor &&that) {
+ derivedTypeSpec_ = that.derivedTypeSpec_;
+ values_ = std::move(that.values_);
+ return *this;
+}
+
+bool StructureConstructor::operator==(const StructureConstructor &that) const {
+ return derivedTypeSpec_ == that.derivedTypeSpec_ && values_ == that.values_;
+}
+
+DynamicType StructureConstructor::GetType() const {
+ return {TypeCategory::Derived, 0, derivedTypeSpec_};
+}
+
+StructureConstructor &StructureConstructor::Add(
+ const Symbol &symbol, Expr<SomeType> &&expr) {
+ values_.emplace_back(&symbol, std::move(expr));
+ return *this;
+}
+
+std::ostream &StructureConstructor::AsFortran(std::ostream &o) const {
+ DerivedTypeSpecAsFortran(o, *derivedTypeSpec_);
+ if (values_.empty()) {
+ o << '(';
+ } else {
+ char ch{'('};
+ for (const auto &[symbol, value] : values_) {
+ value->AsFortran(o << ch << symbol->name().ToString() << '=');
+ ch = ',';
+ }
+ }
+ return o << ')';
}
}
#include <cinttypes>
#include <optional>
#include <string>
+#include <type_traits>
#include <variant>
namespace Fortran::semantics {
// Type functions
-template<typename T> using Scalar = typename std::decay_t<T>::Scalar;
-
// Given a specific type, find the type of the same kind in another category.
template<TypeCategory CATEGORY, typename T>
using SameKind = Type<CATEGORY, std::decay_t<T>::kind>;
constexpr bool IsLengthlessIntrinsicType{
common::HasMember<T, LengthlessIntrinsicTypes>};
-// When Scalar<T> is S, then TypeOf<S> is T.
-// TypeOf is implemented by scanning all supported types for a match
-// with Type<T>::Scalar.
-template<typename CONST> struct TypeOfHelper {
- template<typename T> struct Predicate {
- static constexpr bool value() {
- return std::is_same_v<std::decay_t<CONST>,
- std::decay_t<typename T::Scalar>>;
- }
- };
- static constexpr int index{
- common::SearchMembers<Predicate, AllIntrinsicTypes>};
- using type = std::conditional_t<index >= 0,
- std::tuple_element_t<index, AllIntrinsicTypes>, void>;
-};
-
-template<typename CONST> using TypeOf = typename TypeOfHelper<CONST>::type;
-
// Represents a type of any supported kind within a particular category.
template<TypeCategory CATEGORY> struct SomeKind {
static constexpr TypeCategory category{CATEGORY};
constexpr bool operator==(const SomeKind &) const { return true; }
};
+// Represents a completely generic type (but not typeless).
+struct SomeType {};
+
+// Represents a derived type
+class StructureConstructor;
+
template<> class SomeKind<TypeCategory::Derived> {
public:
static constexpr TypeCategory category{TypeCategory::Derived};
+ using Scalar = StructureConstructor;
CLASS_BOILERPLATE(SomeKind)
explicit SomeKind(const semantics::DerivedTypeSpec &dts,
using SomeCharacter = SomeKind<TypeCategory::Character>;
using SomeLogical = SomeKind<TypeCategory::Logical>;
using SomeDerived = SomeKind<TypeCategory::Derived>;
-
-// Represents a completely generic type (but not typeless).
using SomeCategory = std::tuple<SomeInteger, SomeReal, SomeComplex,
SomeCharacter, SomeLogical, SomeDerived>;
-struct SomeType {};
+
+template<typename T> using Scalar = typename std::decay_t<T>::Scalar;
+
+// When Scalar<T> is S, then TypeOf<S> is T.
+// TypeOf is implemented by scanning all supported types for a match
+// with Type<T>::Scalar.
+template<typename CONST> struct TypeOfHelper {
+ template<typename T> struct Predicate {
+ static constexpr bool value() {
+ return std::is_same_v<std::decay_t<CONST>,
+ std::decay_t<typename T::Scalar>>;
+ }
+ };
+ static constexpr int index{
+ common::SearchMembers<Predicate, AllIntrinsicTypes>};
+ using type = std::conditional_t<index >= 0,
+ std::tuple_element_t<index, AllIntrinsicTypes>, void>;
+};
+
+template<typename CONST> using TypeOf = typename TypeOfHelper<CONST>::type;
// For generating "[extern] template class", &c. boilerplate
#define EXPAND_FOR_EACH_INTEGER_KIND(M, P) \