#include "type.h"
#include "attr.h"
#include <iostream>
+#include <set>
namespace Fortran {
namespace semantics {
}
}
+std::ostream &operator<<(std::ostream &o, const IntExpr &x) {
+ return x.output(o);
+}
+
std::unordered_map<int, IntConst> IntConst::cache;
std::ostream &operator<<(std::ostream &o, const KindParamValue &x) {
return it->second;
}
-const LenParamValue LenParamValue::ASSUMED =
- LenParamValue(LenParamValue::Assumed);
-const LenParamValue LenParamValue::DEFERRED =
- LenParamValue(LenParamValue::Deferred);
-
-std::ostream &operator<<(std::ostream &o, const LenParamValue &x) {
- switch (x.category_) {
- case LenParamValue::Assumed: return o << '*';
- case LenParamValue::Deferred: return o << ':';
- case LenParamValue::Expr: return o << *x.value_;
- default: CRASH_NO_CASE;
- }
+const LogicalTypeSpec *LogicalTypeSpec::make() { return &helper.make(); }
+const LogicalTypeSpec *LogicalTypeSpec::make(KindParamValue kind) {
+ return &helper.make(kind);
}
-
KindedTypeHelper<LogicalTypeSpec> LogicalTypeSpec::helper{"LOGICAL", 0};
std::ostream &operator<<(std::ostream &o, const LogicalTypeSpec &x) {
return LogicalTypeSpec::helper.output(o, x);
}
+const IntegerTypeSpec *IntegerTypeSpec::make() { return &helper.make(); }
+const IntegerTypeSpec *IntegerTypeSpec::make(KindParamValue kind) {
+ return &helper.make(kind);
+}
KindedTypeHelper<IntegerTypeSpec> IntegerTypeSpec::helper{"INTEGER", 0};
std::ostream &operator<<(std::ostream &o, const IntegerTypeSpec &x) {
return IntegerTypeSpec::helper.output(o, x);
}
+const RealTypeSpec *RealTypeSpec::make() { return &helper.make(); }
+const RealTypeSpec *RealTypeSpec::make(KindParamValue kind) {
+ return &helper.make(kind);
+}
KindedTypeHelper<RealTypeSpec> RealTypeSpec::helper{"REAL", 0};
std::ostream &operator<<(std::ostream &o, const RealTypeSpec &x) {
return RealTypeSpec::helper.output(o, x);
}
+const ComplexTypeSpec *ComplexTypeSpec::make() { return &helper.make(); }
+const ComplexTypeSpec *ComplexTypeSpec::make(KindParamValue kind) {
+ return &helper.make(kind);
+}
KindedTypeHelper<ComplexTypeSpec> ComplexTypeSpec::helper{"COMPLEX", 0};
std::ostream &operator<<(std::ostream &o, const ComplexTypeSpec &x) {
return ComplexTypeSpec::helper.output(o, x);
return o << ')';
}
-DerivedTypeDef::DerivedTypeDef(const Name &name, const Attrs &attrs,
- const TypeParamDefs &lenParams, const TypeParamDefs &kindParams,
- bool private_, bool sequence)
- : name_{name}, attrs_{attrs}, lenParams_{lenParams},
- kindParams_{kindParams}, private_{private_}, sequence_{sequence} {
- checkAttrs("DerivedTypeDef", attrs,
- Attrs{Attr::ABSTRACT, Attr::PUBLIC, Attr::PRIVATE, Attr::BIND_C});
-}
-
std::ostream &operator<<(std::ostream &o, const DerivedTypeDef &x) {
o << "TYPE";
- for (auto attr : x.attrs_) {
- o << ", " << attr;
+ if (!x.data_.attrs.empty()) {
+ o << ", " << x.data_.attrs;
}
- o << " :: " << x.name_;
- if (x.lenParams_.size() > 0 || x.kindParams_.size() > 0) {
+ o << " :: " << x.data_.name;
+ if (x.data_.lenParams.size() > 0 || x.data_.kindParams.size() > 0) {
o << '(';
int n = 0;
- for (auto param : x.lenParams_) {
+ for (auto param : x.data_.lenParams) {
if (n++) {
o << ", ";
}
o << param.name();
}
- for (auto param : x.kindParams_) {
+ for (auto param : x.data_.kindParams) {
if (n++) {
o << ", ";
}
o << ')';
}
o << '\n';
- for (auto param : x.lenParams_) {
+ for (auto param : x.data_.lenParams) {
o << " " << param.type() << ", LEN :: " << param.name() << "\n";
}
- for (auto param : x.kindParams_) {
+ for (auto param : x.data_.kindParams) {
o << " " << param.type() << ", KIND :: " << param.name() << "\n";
}
- if (x.private_) {
+ if (x.data_.Private) {
o << " PRIVATE\n";
}
- if (x.sequence_) {
+ if (x.data_.sequence) {
o << " SEQUENCE\n";
}
- // components
+ for (auto comp : x.data_.dataComps) {
+ o << " " << comp << "\n";
+ }
+ for (auto comp : x.data_.procComps) {
+ o << " " << comp << "\n";
+ }
return o << "END TYPE\n";
}
DerivedTypeSpec::DerivedTypeSpec(DerivedTypeDef def,
- KindParamValues kindParamValues, LenParamValues lenParamValues)
+ const KindParamValues &kindParamValues,
+ const LenParamValues &lenParamValues)
: def_{def}, kindParamValues_{kindParamValues}, lenParamValues_{
lenParamValues} {
- checkParams("kind", def.kindParams_, kindParamValues);
- checkParams("len", def.lenParams_, lenParamValues);
+ checkParams("kind", def.kindParams(), kindParamValues);
+ checkParams("len", def.lenParams(), lenParamValues);
}
std::ostream &operator<<(std::ostream &o, const DerivedTypeSpec &x) {
- o << "TYPE(" << x.def_.name_;
+ o << "TYPE(" << x.def_.name();
if (x.kindParamValues_.size() > 0 || x.lenParamValues_.size() > 0) {
o << '(';
int n = 0;
return o;
}
+std::ostream &operator<<(std::ostream &o, const DataComponentDef &x) {
+ o << x.type_;
+ if (!x.attrs_.empty()) {
+ o << ", " << x.attrs_;
+ }
+ o << " :: " << x.name_;
+ if (!x.arraySpec_.empty()) {
+ o << '(';
+ int n = 0;
+ for (ShapeSpec shape : x.arraySpec_) {
+ if (n++) {
+ o << ", ";
+ }
+ o << shape;
+ }
+ o << ')';
+ }
+ return o;
+}
+
+DataComponentDef::DataComponentDef(const DeclTypeSpec &type, const Name &name,
+ const Attrs &attrs, const ComponentArraySpec &arraySpec)
+ : type_{type}, name_{name}, attrs_{attrs}, arraySpec_{arraySpec} {
+ attrs.checkValid({Attr::PUBLIC, Attr::PRIVATE, Attr::ALLOCATABLE,
+ Attr::POINTER, Attr::CONTIGUOUS});
+ if (attrs.hasAny({Attr::ALLOCATABLE, Attr::POINTER})) {
+ for (auto shapeSpec : arraySpec) {
+ CHECK(shapeSpec.isDeferred());
+ }
+ } else {
+ for (auto shapeSpec : arraySpec) {
+ CHECK(shapeSpec.isExplicit());
+ }
+ }
+}
+
+std::ostream &operator<<(std::ostream &o, const DeclTypeSpec &x) {
+ // TODO: need CLASS(...) instead of TYPE() for ClassDerived
+ switch (x.category_) {
+ case DeclTypeSpec::Intrinsic: return x.intrinsicTypeSpec_->output(o);
+ case DeclTypeSpec::TypeDerived: return o << *x.derivedTypeSpec_;
+ case DeclTypeSpec::ClassDerived: return o << *x.derivedTypeSpec_;
+ case DeclTypeSpec::TypeStar: return o << "TYPE(*)";
+ case DeclTypeSpec::ClassStar: return o << "CLASS(*)";
+ default: CRASH_NO_CASE;
+ }
+}
+
+std::ostream &operator<<(std::ostream &o, const ProcDecl &x) {
+ return o << x.name_;
+}
+
+ProcComponentDef::ProcComponentDef(ProcDecl decl, Attrs attrs,
+ const std::optional<Name> &interfaceName,
+ const std::optional<DeclTypeSpec> &typeSpec)
+ : decl_{decl}, attrs_{attrs}, interfaceName_{interfaceName}, typeSpec_{
+ typeSpec} {
+ CHECK(attrs_.has(Attr::POINTER));
+ attrs_.checkValid(
+ {Attr::PUBLIC, Attr::PRIVATE, Attr::NOPASS, Attr::POINTER, Attr::PASS});
+ CHECK(!interfaceName || !typeSpec); // can't both be defined
+}
+std::ostream &operator<<(std::ostream &o, const ProcComponentDef &x) {
+ o << "PROCEDURE(";
+ if (x.interfaceName_) {
+ o << *x.interfaceName_;
+ } else if (x.typeSpec_) {
+ o << *x.typeSpec_;
+ }
+ o << "), " << x.attrs_ << " :: " << x.decl_ << "\n";
+ return o;
+}
+
+DerivedTypeDef::DerivedTypeDef(const DerivedTypeDef::Data &data)
+ : data_{data} {}
+
+DerivedTypeDefBuilder &DerivedTypeDefBuilder::extends(const Name &x) {
+ data_.extends = x;
+ return *this;
+}
+DerivedTypeDefBuilder &DerivedTypeDefBuilder::attr(const Attr &x) {
+ // TODO: x.checkValid({Attr::ABSTRACT, Attr::PUBLIC, Attr::PRIVATE,
+ // Attr::BIND_C});
+ data_.attrs.set(x);
+ return *this;
+}
+DerivedTypeDefBuilder &DerivedTypeDefBuilder::attrs(const Attrs &x) {
+ x.checkValid({Attr::ABSTRACT, Attr::PUBLIC, Attr::PRIVATE, Attr::BIND_C});
+ data_.attrs.add(x);
+ return *this;
+}
+DerivedTypeDefBuilder &DerivedTypeDefBuilder::lenParam(const TypeParamDef &x) {
+ data_.lenParams.push_back(x);
+ return *this;
+}
+DerivedTypeDefBuilder &DerivedTypeDefBuilder::kindParam(const TypeParamDef &x) {
+ data_.kindParams.push_back(x);
+ return *this;
+}
+DerivedTypeDefBuilder &DerivedTypeDefBuilder::dataComponent(
+ const DataComponentDef &x) {
+ data_.dataComps.push_back(x);
+ return *this;
+}
+DerivedTypeDefBuilder &DerivedTypeDefBuilder::procComponent(
+ const ProcComponentDef &x) {
+ data_.procComps.push_back(x);
+ return *this;
+}
+DerivedTypeDefBuilder &DerivedTypeDefBuilder::Private(bool x) {
+ data_.Private = x;
+ return *this;
+}
+DerivedTypeDefBuilder &DerivedTypeDefBuilder::sequence(bool x) {
+ data_.sequence = x;
+ return *this;
+}
+
} // namespace semantics
} // namespace Fortran
using namespace Fortran::semantics;
void testTypeSpec() {
- LogicalTypeSpec l1 = LogicalTypeSpec::make();
- LogicalTypeSpec l2 = LogicalTypeSpec::make(2);
- std::cout << l1 << "\n";
- std::cout << l2 << "\n";
- RealTypeSpec r1 = RealTypeSpec::make();
- RealTypeSpec r2 = RealTypeSpec::make(2);
- std::cout << r1 << "\n";
- std::cout << r2 << "\n";
- CharacterTypeSpec c1{LenParamValue::DEFERRED, 1};
+ const LogicalTypeSpec *l1 = LogicalTypeSpec::make();
+ const LogicalTypeSpec *l2 = LogicalTypeSpec::make(2);
+ std::cout << *l1 << "\n";
+ std::cout << *l2 << "\n";
+ const RealTypeSpec *r1 = RealTypeSpec::make();
+ const RealTypeSpec *r2 = RealTypeSpec::make(2);
+ std::cout << *r1 << "\n";
+ std::cout << *r2 << "\n";
+ const CharacterTypeSpec c1{LenParamValue::DEFERRED, 1};
std::cout << c1 << "\n";
- CharacterTypeSpec c2{IntConst::make(10)};
+ const CharacterTypeSpec c2{IntConst::make(10)};
std::cout << c2 << "\n";
- IntegerTypeSpec i1 = IntegerTypeSpec::make();
- IntegerTypeSpec i2 = IntegerTypeSpec::make(2);
- TypeParamDef lenParam{"my_len", i2};
- TypeParamDef kindParam{"my_kind", i1};
-
- DerivedTypeDef def1{
- "my_name",
- {Attr::PRIVATE, Attr::BIND_C},
- TypeParamDefs{lenParam},
- TypeParamDefs{kindParam},
- sequence : true
- };
+ const IntegerTypeSpec *i1 = IntegerTypeSpec::make();
+ const IntegerTypeSpec *i2 = IntegerTypeSpec::make(2);
+ TypeParamDef lenParam{"my_len", *i2};
+ TypeParamDef kindParam{"my_kind", *i1};
+
+ DerivedTypeDef def1{DerivedTypeDefBuilder("my_name")
+ .attrs({Attr::PRIVATE, Attr::BIND_C})
+ .lenParam(lenParam)
+ .kindParam(kindParam)
+ .sequence()};
+ // DerivedTypeDef def1{"my_name", {Attr::PRIVATE, Attr::BIND_C},
+ // TypeParamDefs{lenParam}, TypeParamDefs{kindParam}, false, true};
LenParamValues lenParamValues{
LenParamValues::value_type{"my_len", LenParamValue::ASSUMED},
KindParamValues kindParamValues{
KindParamValues::value_type{"my_kind", KindParamValue{123}},
};
- DerivedTypeSpec dt1{def1, kindParamValues, lenParamValues};
- std::cout << dt1 << "\n";
+ // DerivedTypeSpec dt1{def1, kindParamValues, lenParamValues};
+
+ // DerivedTypeSpec dt1{DerivedTypeSpec::Builder{"my_name2"}
+ // .lenParamValue("my_len", LenParamValue::ASSUMED)
+ // .attrs({Attr::BIND_C}).lenParam(lenParam)};
+ // std::cout << dt1 << "\n";
}
void testShapeSpec() {
std::cout << "assumed-rank-spec: " << s7 << "\n";
}
+void testDataComponentDef() {
+ DataComponentDef def1{
+ DeclTypeSpec::makeClassStar(), "foo", Attrs{Attr::PUBLIC}};
+ std::cout << "data-component-def: " << def1 << "\n";
+ DataComponentDef def2{DeclTypeSpec::makeTypeStar(), "foo", Attrs{},
+ ComponentArraySpec{ShapeSpec::makeExplicit(IntConst::make(10))}};
+ std::cout << "data-component-def: " << def2 << "\n";
+}
+
+void testProcComponentDef() {
+ ProcDecl decl{"foo"};
+ ProcComponentDef def1{decl, Attrs{Attr::POINTER, Attr::PUBLIC, Attr::NOPASS}};
+ std::cout << "proc-component-def: " << def1;
+ ProcComponentDef def2{decl, Attrs{Attr::POINTER}, Name{"my_interface"}};
+ std::cout << "proc-component-def: " << def2;
+ ProcComponentDef def3{
+ decl, Attrs{Attr::POINTER}, DeclTypeSpec::makeTypeStar()};
+ std::cout << "proc-component-def: " << def3;
+}
+
+#if 0
int main() {
testTypeSpec();
- testShapeSpec();
+ //testShapeSpec();
+ //testProcComponentDef();
+ //testDataComponentDef();
return 0;
}
+#endif
#include "../parser/idioms.h"
#include "attr.h"
-#include <algorithm>
#include <list>
#include <map>
#include <memory>
#include <sstream>
#include <string>
#include <unordered_map>
-#include <vector>
/*
A DerivedTypeSpec is based on a DerivedTypeDef (from a derived type statement)
with kind and len parameter values provided.
-Attributes:
-The enum class Attr contains all possible attributes. DerivedTypeDef checks
-that supplied attributes are among the allowed ones using checkAttrs().
-
*/
namespace Fortran {
virtual const IntExpr *clone() const { return new IntExpr{*this}; }
virtual std::ostream &output(std::ostream &o) const { return o << "IntExpr"; }
};
-std::ostream &operator<<(std::ostream &o, const IntExpr &x) {
- return x.output(o);
-}
// TODO
class IntConst : public IntExpr {
public:
static const IntConst &make(int value);
- virtual const IntExpr *clone() const { return &make(value_); }
+ const IntExpr *clone() const override { return &make(value_); }
bool operator==(const IntConst &x) const { return value_ == x.value_; }
bool operator!=(const IntConst &x) const { return !operator==(x); }
bool operator<(const IntConst &x) const { return value_ < x.value_; }
- virtual std::ostream &output(std::ostream &o) const {
+ std::ostream &output(std::ostream &o) const override {
return o << this->value_;
}
// The value of a kind type parameter
class KindParamValue {
public:
- KindParamValue(int value) : value_{IntConst::make(value)} {}
+ KindParamValue(int value = 0) : value_{IntConst::make(value)} {}
bool operator==(const KindParamValue &x) const { return value_ == x.value_; }
bool operator!=(const KindParamValue &x) const { return !operator==(x); }
bool operator<(const KindParamValue &x) const { return value_ < x.value_; }
friend std::ostream &operator<<(std::ostream &, const KindParamValue &);
};
+// An array spec bound: an explicit integer expression or ASSUMED or DEFERRED
+class Bound {
+public:
+ static const Bound ASSUMED;
+ static const Bound DEFERRED;
+ Bound(const IntExpr &expr) : category_{Explicit}, expr_{expr.clone()} {}
+ bool isExplicit() const { return category_ == Explicit; }
+ bool isAssumed() const { return category_ == Assumed; }
+ bool isDeferred() const { return category_ == Deferred; }
+ const IntExpr &getExplicit() const { return *expr_; }
+
+private:
+ enum Category { Explicit, Deferred, Assumed };
+ Bound(Category category) : category_{category}, expr_{&IntConst::make(0)} {}
+ const Category category_;
+ const IntExpr *const expr_;
+ friend std::ostream &operator<<(std::ostream &, const Bound &);
+};
+
// The value of a len type parameter
-class LenParamValue {
+using LenParamValue = Bound;
+
+class IntrinsicTypeSpec;
+class DerivedTypeSpec;
+class DeclTypeSpec {
public:
- static const LenParamValue ASSUMED;
- static const LenParamValue DEFERRED;
- LenParamValue(const IntExpr &value) : category_{Expr}, value_{value} {}
+ // intrinsic-type-spec or TYPE(intrinsic-type-spec)
+ static DeclTypeSpec makeIntrinsic(
+ const IntrinsicTypeSpec *intrinsicTypeSpec) {
+ return DeclTypeSpec{Intrinsic, intrinsicTypeSpec};
+ }
+ // TYPE(derived-type-spec)
+ static DeclTypeSpec makeTypeDerivedType(
+ const DerivedTypeSpec *derivedTypeSpec) {
+ return DeclTypeSpec{TypeDerived, nullptr, derivedTypeSpec};
+ }
+ // CLASS(derived-type-spec)
+ static DeclTypeSpec makeClassDerivedType(
+ const DerivedTypeSpec *derivedTypeSpec) {
+ return DeclTypeSpec{ClassDerived, nullptr, derivedTypeSpec};
+ }
+ // TYPE(*)
+ static DeclTypeSpec makeTypeStar() { return DeclTypeSpec{TypeStar}; }
+ // CLASS(*)
+ static DeclTypeSpec makeClassStar() { return DeclTypeSpec{ClassStar}; }
+
+ enum Category { Intrinsic, TypeDerived, ClassDerived, TypeStar, ClassStar };
+ Category category() const { return category_; }
+ const IntrinsicTypeSpec *intrinsicTypeSpec() const {
+ return intrinsicTypeSpec_;
+ }
+ const DerivedTypeSpec *derivedTypeSpec() const { return derivedTypeSpec_; }
private:
- enum Category { Assumed, Deferred, Expr };
- LenParamValue(Category category) : category_{category} {}
+ DeclTypeSpec(Category category,
+ const IntrinsicTypeSpec *intrinsicTypeSpec = nullptr,
+ const DerivedTypeSpec *derivedTypeSpec = nullptr)
+ : category_{category}, intrinsicTypeSpec_{intrinsicTypeSpec},
+ derivedTypeSpec_{derivedTypeSpec} {}
const Category category_;
- const std::optional<const IntExpr> value_;
- friend std::ostream &operator<<(std::ostream &, const LenParamValue &);
+ const IntrinsicTypeSpec *const intrinsicTypeSpec_;
+ const DerivedTypeSpec *const derivedTypeSpec_;
+ friend std::ostream &operator<<(std::ostream &, const DeclTypeSpec &);
};
// Root of the *TypeSpec hierarchy
class TypeSpec {
-protected:
- TypeSpec() {}
- virtual ~TypeSpec() = 0;
+public:
+ virtual std::ostream &output(std::ostream &o) const = 0;
};
-TypeSpec::~TypeSpec() {}
class IntrinsicTypeSpec : public TypeSpec {
public:
protected:
IntrinsicTypeSpec(KindParamValue kind) : kind_{kind} {}
- virtual ~IntrinsicTypeSpec() = 0;
const KindParamValue kind_;
};
-IntrinsicTypeSpec::~IntrinsicTypeSpec() {}
class NumericTypeSpec : public IntrinsicTypeSpec {
protected:
NumericTypeSpec(KindParamValue kind) : IntrinsicTypeSpec(kind) {}
- virtual ~NumericTypeSpec() = 0;
};
-NumericTypeSpec::~NumericTypeSpec() {}
namespace {
// One unique instance of LogicalTypeSpec for each kind.
class LogicalTypeSpec : public IntrinsicTypeSpec {
public:
- static const LogicalTypeSpec &make() { return helper.make(); }
- static const LogicalTypeSpec &make(KindParamValue kind) {
- return helper.make(kind);
- }
+ static const LogicalTypeSpec *make();
+ static const LogicalTypeSpec *make(KindParamValue kind);
+ std::ostream &output(std::ostream &o) const override { return o << *this; }
private:
friend class KindedTypeHelper<LogicalTypeSpec>;
// One unique instance of IntegerTypeSpec for each kind.
class IntegerTypeSpec : public NumericTypeSpec {
public:
- static const IntegerTypeSpec &make() { return helper.make(); }
- static const IntegerTypeSpec &make(KindParamValue kind) {
- return helper.make(kind);
- }
+ static const IntegerTypeSpec *make();
+ static const IntegerTypeSpec *make(KindParamValue kind);
+ std::ostream &output(std::ostream &o) const override { return o << *this; }
private:
friend class KindedTypeHelper<IntegerTypeSpec>;
// One unique instance of RealTypeSpec for each kind.
class RealTypeSpec : public NumericTypeSpec {
public:
- static const RealTypeSpec &make() { return helper.make(); }
- static const RealTypeSpec &make(KindParamValue kind) {
- return helper.make(kind);
- }
+ static const RealTypeSpec *make();
+ static const RealTypeSpec *make(KindParamValue kind);
+ std::ostream &output(std::ostream &o) const override { return o << *this; }
private:
friend class KindedTypeHelper<RealTypeSpec>;
// One unique instance of ComplexTypeSpec for each kind.
class ComplexTypeSpec : public NumericTypeSpec {
public:
- static const ComplexTypeSpec &make() { return helper.make(); }
- static const ComplexTypeSpec &make(KindParamValue kind) {
- return helper.make(kind);
- }
+ static const ComplexTypeSpec *make();
+ static const ComplexTypeSpec *make(KindParamValue kind);
+ std::ostream &output(std::ostream &o) const override { return o << *this; }
private:
friend class KindedTypeHelper<ComplexTypeSpec>;
static const int DefaultKind = 0;
CharacterTypeSpec(LenParamValue len, KindParamValue kind = DefaultKind)
: IntrinsicTypeSpec{kind}, len_{len} {}
+ std::ostream &output(std::ostream &o) const override { return o << *this; }
private:
const LenParamValue len_;
const std::optional<IntConst> defaultValue_;
};
-using TypeParamDefs = std::vector<TypeParamDef>;
-
-// Definition of a derived type
-class DerivedTypeDef {
-public:
- DerivedTypeDef(const Name &name, const Attrs &attrs = {},
- const TypeParamDefs &lenParams = {}, const TypeParamDefs &kindParams = {},
- bool private_ = false, bool sequence = false);
- const Name name_;
- const std::optional<Name> parent_ = {};
- const Attrs attrs_;
- const TypeParamDefs lenParams_;
- const TypeParamDefs kindParams_;
- const bool private_ = false;
- const bool sequence_ = false;
- // TODO: components
- // TODO: type-bound procedures
- friend std::ostream &operator<<(std::ostream &, const DerivedTypeDef &);
-};
-
-using KindParamValues = std::map<Name, KindParamValue>;
-using LenParamValues = std::map<Name, LenParamValue>;
-
-// Instantiation of a DerivedTypeDef with kind and len parameter values
-class DerivedTypeSpec : public TypeSpec {
-public:
- DerivedTypeSpec(DerivedTypeDef def, KindParamValues kindParamValues = {},
- LenParamValues lenParamValues = {});
-
-private:
- const DerivedTypeDef def_;
- const KindParamValues kindParamValues_;
- const LenParamValues lenParamValues_;
- friend std::ostream &operator<<(std::ostream &, const DerivedTypeSpec &);
-};
-
-class DeclTypeSpec {
-public:
- // intrinsic-type-spec or TYPE(intrinsic-type-spec)
- static DeclTypeSpec makeIntrinsic(
- const IntrinsicTypeSpec *intrinsicTypeSpec) {
- return DeclTypeSpec{Intrinsic, intrinsicTypeSpec};
- }
- // TYPE(derived-type-spec)
- static DeclTypeSpec makeTypeDerivedType(
- const DerivedTypeSpec *derivedTypeSpec) {
- return DeclTypeSpec{TypeDerived, nullptr, derivedTypeSpec};
- }
- // CLASS(derived-type-spec)
- static DeclTypeSpec makeClassDerivedType(
- const DerivedTypeSpec *derivedTypeSpec) {
- return DeclTypeSpec{ClassDerived, nullptr, derivedTypeSpec};
- }
- // TYPE(*)
- static DeclTypeSpec makeTypeStar() { return DeclTypeSpec{TypeStar}; }
- // CLASS(*)
- static DeclTypeSpec makeClassStar() { return DeclTypeSpec{ClassStar}; }
-
- enum Category { Intrinsic, TypeDerived, ClassDerived, TypeStar, ClassStar };
- Category category() const { return category_; }
- const IntrinsicTypeSpec &intrinsicTypeSpec() const {
- return *intrinsicTypeSpec_;
- }
- const DerivedTypeSpec &derivedTypeSpec() const { return *derivedTypeSpec_; }
-
-private:
- DeclTypeSpec(Category category,
- const IntrinsicTypeSpec *intrinsicTypeSpec = nullptr,
- const DerivedTypeSpec *derivedTypeSpec = nullptr)
- : category_{category}, intrinsicTypeSpec_{intrinsicTypeSpec},
- derivedTypeSpec_{derivedTypeSpec} {}
- const Category category_;
- const IntrinsicTypeSpec *const intrinsicTypeSpec_;
- const DerivedTypeSpec *const derivedTypeSpec_;
-};
-
-class DataComponentDef {
-public:
- // component-array-spec
- // coarray-spec
- DataComponentDef(
- const DeclTypeSpec &type, const Name &name, const Attrs &attrs)
- : type_{type}, name_{name}, attrs_{attrs} {
- checkAttrs("DataComponentDef", attrs,
- Attrs{Attr::PUBLIC, Attr::PRIVATE, Attr::ALLOCATABLE, Attr::CONTIGUOUS,
- Attr::POINTER});
- }
-
-private:
- const DeclTypeSpec type_;
- const Name name_;
- const Attrs attrs_;
-};
-
-// An array spec bound: an explicit integer expression or ASSUMED or DEFERRED
-class Bound {
-public:
- static const Bound ASSUMED;
- static const Bound DEFERRED;
- Bound(const IntExpr &expr) : category_{Explicit}, expr_{expr.clone()} {}
- bool isExplicit() const { return category_ == Explicit; }
- bool isAssumed() const { return category_ == Assumed; }
- bool isDeferred() const { return category_ == Deferred; }
- const IntExpr &getExplicit() const { return *expr_; }
-
-private:
- enum Category { Explicit, Deferred, Assumed };
- Bound(Category category) : category_{category}, expr_{&IntConst::make(0)} {}
- const Category category_;
- const IntExpr *const expr_;
- friend std::ostream &operator<<(std::ostream &, const Bound &);
-};
+using TypeParamDefs = std::list<TypeParamDef>;
class ShapeSpec {
public:
static ShapeSpec makeAssumedRank() {
return ShapeSpec(Bound::ASSUMED, Bound::ASSUMED);
}
- friend std::ostream &operator<<(std::ostream &, const ShapeSpec &);
+
+ bool isExplicit() const { return ub_.isExplicit(); }
+ bool isDeferred() const { return lb_.isDeferred(); }
private:
ShapeSpec(const Bound &lb, const Bound &ub) : lb_{lb}, ub_{ub} {}
const Bound lb_;
const Bound ub_;
+ friend std::ostream &operator<<(std::ostream &, const ShapeSpec &);
+};
+
+using ComponentArraySpec = std::list<ShapeSpec>;
+
+class DataComponentDef {
+public:
+ // TODO: character-length - should be in DeclTypeSpec (overrides what is
+ // there)
+ // TODO: coarray-spec
+ // TODO: component-initialization
+ DataComponentDef(
+ const DeclTypeSpec &type, const Name &name, const Attrs &attrs)
+ : DataComponentDef(type, name, attrs, ComponentArraySpec{}) {}
+ DataComponentDef(const DeclTypeSpec &type, const Name &name,
+ const Attrs &attrs, const ComponentArraySpec &arraySpec);
+
+private:
+ const DeclTypeSpec type_;
+ const Name name_;
+ const Attrs attrs_;
+ const ComponentArraySpec arraySpec_;
+ friend std::ostream &operator<<(std::ostream &, const DataComponentDef &);
+};
+
+class ProcDecl {
+public:
+ ProcDecl(const Name &name) : name_{name} {}
+ // TODO: proc-pointer-init
+private:
+ const Name name_;
+ friend std::ostream &operator<<(std::ostream &, const ProcDecl &);
+};
+
+class ProcComponentDef {
+public:
+ ProcComponentDef(ProcDecl decl, Attrs attrs)
+ : ProcComponentDef(decl, attrs, std::nullopt, std::nullopt) {}
+ ProcComponentDef(ProcDecl decl, Attrs attrs, const Name &interfaceName)
+ : ProcComponentDef(decl, attrs, interfaceName, std::nullopt) {}
+ ProcComponentDef(ProcDecl decl, Attrs attrs, const DeclTypeSpec &typeSpec)
+ : ProcComponentDef(decl, attrs, std::nullopt, typeSpec) {}
+
+private:
+ ProcComponentDef(ProcDecl decl, Attrs attrs,
+ const std::optional<Name> &interfaceName,
+ const std::optional<DeclTypeSpec> &typeSpec);
+ const ProcDecl decl_;
+ const Attrs attrs_;
+ const std::optional<Name> interfaceName_;
+ const std::optional<DeclTypeSpec> typeSpec_;
+ friend std::ostream &operator<<(std::ostream &, const ProcComponentDef &);
+};
+
+class DerivedTypeDefBuilder;
+
+// Definition of a derived type
+class DerivedTypeDef {
+public:
+ const Name &name() const { return data_.name; }
+ const std::optional<Name> &extends() const { return data_.extends; }
+ const TypeParamDefs &lenParams() const { return data_.lenParams; }
+ const TypeParamDefs &kindParams() const { return data_.kindParams; }
+ const std::list<DataComponentDef> &dataComponents() const {
+ return data_.dataComps;
+ }
+ const std::list<ProcComponentDef> &procComponents() const {
+ return data_.procComps;
+ }
+
+private:
+ struct Data {
+ Name name;
+ std::optional<Name> extends;
+ Attrs attrs;
+ bool Private{false};
+ bool sequence{false};
+ TypeParamDefs lenParams;
+ TypeParamDefs kindParams;
+ std::list<DataComponentDef> dataComps;
+ std::list<ProcComponentDef> procComps;
+ };
+ friend class DerivedTypeDefBuilder;
+ explicit DerivedTypeDef(const Data &x);
+ const Data data_;
+ // TODO: type-bound procedures
+ friend std::ostream &operator<<(std::ostream &, const DerivedTypeDef &);
+};
+
+class DerivedTypeDefBuilder {
+public:
+ DerivedTypeDefBuilder(const Name &name) { data_.name = name; }
+ operator DerivedTypeDef() const { return DerivedTypeDef(data_); }
+ DerivedTypeDefBuilder &extends(const Name &x);
+ DerivedTypeDefBuilder &attr(const Attr &x);
+ DerivedTypeDefBuilder &attrs(const Attrs &x);
+ DerivedTypeDefBuilder &lenParam(const TypeParamDef &x);
+ DerivedTypeDefBuilder &kindParam(const TypeParamDef &x);
+ DerivedTypeDefBuilder &dataComponent(const DataComponentDef &x);
+ DerivedTypeDefBuilder &procComponent(const ProcComponentDef &x);
+ DerivedTypeDefBuilder &Private(bool x = true);
+ DerivedTypeDefBuilder &sequence(bool x = true);
+
+private:
+ DerivedTypeDef::Data data_;
+ friend class DerivedTypeDef;
+};
+
+using KindParamValues = std::map<Name, KindParamValue>;
+using LenParamValues = std::map<Name, LenParamValue>;
+
+// Instantiation of a DerivedTypeDef with kind and len parameter values
+class DerivedTypeSpec : public TypeSpec {
+public:
+ std::ostream &output(std::ostream &o) const override { return o << *this; }
+
+private:
+ const DerivedTypeDef def_;
+ const KindParamValues kindParamValues_;
+ const LenParamValues lenParamValues_;
+ DerivedTypeSpec(DerivedTypeDef def, const KindParamValues &kindParamValues,
+ const LenParamValues &lenParamValues);
+ friend std::ostream &operator<<(std::ostream &, const DerivedTypeSpec &);
};
} // namespace semantics
projects / platform / upstream / llvm.git / commitdiff