From cbd894be7812602bd639b74bf9ae5fd7480efd7b Mon Sep 17 00:00:00 2001 From: Tim Keith Date: Wed, 14 Feb 2018 15:24:02 -0800 Subject: [PATCH] [flang] Continue adding to type.h New classes: Bound, DeclTypeSpec, ShapeSpec, ComponentArraySpec, DataComponentDef, ProcDecl, ProcComponentDef, DerivedTypedef Original-commit: flang-compiler/f18@a09d1e8c81145a0dc92a8e26c0ca5a6a622309fd Reviewed-on: https://github.com/flang-compiler/f18/pull/8 Tree-same-pre-rewrite: false --- flang/lib/semantics/type.cc | 274 +++++++++++++++++++++++++-------- flang/lib/semantics/type.h | 360 +++++++++++++++++++++++++------------------- 2 files changed, 415 insertions(+), 219 deletions(-) diff --git a/flang/lib/semantics/type.cc b/flang/lib/semantics/type.cc index 9a9ed73..52fedd5 100644 --- a/flang/lib/semantics/type.cc +++ b/flang/lib/semantics/type.cc @@ -1,6 +1,7 @@ #include "type.h" #include "attr.h" #include +#include namespace Fortran { namespace semantics { @@ -28,6 +29,10 @@ static void checkParams( } } +std::ostream &operator<<(std::ostream &o, const IntExpr &x) { + return x.output(o); +} + std::unordered_map IntConst::cache; std::ostream &operator<<(std::ostream &o, const KindParamValue &x) { @@ -42,35 +47,37 @@ const IntConst &IntConst::make(int value) { 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::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::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::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::helper{"COMPLEX", 0}; std::ostream &operator<<(std::ostream &o, const ComplexTypeSpec &x) { return ComplexTypeSpec::helper.output(o, x); @@ -84,31 +91,22 @@ std::ostream &operator<<(std::ostream &o, const CharacterTypeSpec &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 << ", "; } @@ -117,32 +115,38 @@ std::ostream &operator<<(std::ostream &o, const DerivedTypeDef &x) { 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; @@ -194,37 +198,155 @@ std::ostream &operator<<(std::ostream &o, const ShapeSpec &x) { 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 &interfaceName, + const std::optional &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}, @@ -232,8 +354,12 @@ void testTypeSpec() { 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() { @@ -258,8 +384,32 @@ 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 diff --git a/flang/lib/semantics/type.h b/flang/lib/semantics/type.h index 117d30f..44c21ee 100644 --- a/flang/lib/semantics/type.h +++ b/flang/lib/semantics/type.h @@ -3,7 +3,6 @@ #include "../parser/idioms.h" #include "attr.h" -#include #include #include #include @@ -12,7 +11,6 @@ #include #include #include -#include /* @@ -34,10 +32,6 @@ is a limited number of instances -- one for each kind. 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 { @@ -51,19 +45,16 @@ public: 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_; } @@ -76,7 +67,7 @@ private: // 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_; } @@ -86,28 +77,76 @@ private: 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 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: @@ -115,17 +154,13 @@ 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 { @@ -159,10 +194,9 @@ private: // 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; @@ -174,10 +208,9 @@ private: // 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; @@ -189,10 +222,9 @@ private: // 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; @@ -204,10 +236,9 @@ private: // 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; @@ -221,6 +252,7 @@ public: 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_; @@ -243,118 +275,7 @@ private: const std::optional defaultValue_; }; -using TypeParamDefs = std::vector; - -// 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 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; -using LenParamValues = std::map; - -// 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; class ShapeSpec { public: @@ -382,12 +303,137 @@ 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; + +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 &interfaceName, + const std::optional &typeSpec); + const ProcDecl decl_; + const Attrs attrs_; + const std::optional interfaceName_; + const std::optional 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 &extends() const { return data_.extends; } + const TypeParamDefs &lenParams() const { return data_.lenParams; } + const TypeParamDefs &kindParams() const { return data_.kindParams; } + const std::list &dataComponents() const { + return data_.dataComps; + } + const std::list &procComponents() const { + return data_.procComps; + } + +private: + struct Data { + Name name; + std::optional extends; + Attrs attrs; + bool Private{false}; + bool sequence{false}; + TypeParamDefs lenParams; + TypeParamDefs kindParams; + std::list dataComps; + std::list 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; +using LenParamValues = std::map; + +// 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 -- 2.7.4