DerivedTypeSpec *derivedTypeSpec_{nullptr};
std::unique_ptr<ParamValue> typeParamValue_;
- void MakeIntrinsic(const IntrinsicTypeSpec &intrinsicTypeSpec);
+ void MakeIntrinsic(TypeCategory, int);
void SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec);
- static KindParamValue GetKindParamValue(
- const std::optional<parser::KindSelector> &kind);
+ static int GetKindParamValue(const std::optional<parser::KindSelector> &kind);
};
// Track statement source locations and save messages.
} else if (inheritFromParent_) {
return parent_->GetType(ch);
} else if (ch >= 'i' && ch <= 'n') {
- return DeclTypeSpec{IntegerTypeSpec::Make()};
+ return DeclTypeSpec{IntrinsicTypeSpec{TypeCategory::Integer}};
} else if (ch >= 'a' && ch <= 'z') {
- return DeclTypeSpec{RealTypeSpec::Make()};
+ return DeclTypeSpec{IntrinsicTypeSpec{TypeCategory::Real}};
} else {
return std::nullopt;
}
}
bool DeclTypeSpecVisitor::Pre(const parser::IntegerTypeSpec &x) {
- MakeIntrinsic(IntegerTypeSpec::Make(GetKindParamValue(x.v)));
+ MakeIntrinsic(TypeCategory::Integer, GetKindParamValue(x.v));
return false;
}
void DeclTypeSpecVisitor::Post(const parser::IntrinsicTypeSpec::Character &x) {
CHECK(!"TODO: character");
}
bool DeclTypeSpecVisitor::Pre(const parser::IntrinsicTypeSpec::Logical &x) {
- MakeIntrinsic(LogicalTypeSpec::Make(GetKindParamValue(x.kind)));
+ MakeIntrinsic(TypeCategory::Logical, GetKindParamValue(x.kind));
return false;
}
bool DeclTypeSpecVisitor::Pre(const parser::IntrinsicTypeSpec::Real &x) {
- MakeIntrinsic(RealTypeSpec::Make(GetKindParamValue(x.kind)));
+ MakeIntrinsic(TypeCategory::Real, GetKindParamValue(x.kind));
return false;
}
bool DeclTypeSpecVisitor::Pre(const parser::IntrinsicTypeSpec::Complex &x) {
- MakeIntrinsic(ComplexTypeSpec::Make(GetKindParamValue(x.kind)));
+ MakeIntrinsic(TypeCategory::Complex, GetKindParamValue(x.kind));
return false;
}
bool DeclTypeSpecVisitor::Pre(
const parser::IntrinsicTypeSpec::DoublePrecision &) {
- CHECK(!"TODO: double precision");
+ MakeIntrinsic(TypeCategory::Real,
+ 2 * IntrinsicTypeSpec::GetDefaultKind(TypeCategory::Real));
return false;
}
bool DeclTypeSpecVisitor::Pre(
const parser::IntrinsicTypeSpec::DoubleComplex &) {
- CHECK(!"TODO: double complex");
+ MakeIntrinsic(TypeCategory::Complex,
+ 2 * IntrinsicTypeSpec::GetDefaultKind(TypeCategory::Complex));
return false;
}
-void DeclTypeSpecVisitor::MakeIntrinsic(
- const IntrinsicTypeSpec &intrinsicTypeSpec) {
- SetDeclTypeSpec(DeclTypeSpec{intrinsicTypeSpec});
+void DeclTypeSpecVisitor::MakeIntrinsic(TypeCategory category, int kind) {
+ SetDeclTypeSpec(DeclTypeSpec{IntrinsicTypeSpec{category, kind}});
}
// Set declTypeSpec_ based on derivedTypeSpec_
declTypeSpec_ = std::make_unique<DeclTypeSpec>(declTypeSpec);
}
-KindParamValue DeclTypeSpecVisitor::GetKindParamValue(
+int DeclTypeSpecVisitor::GetKindParamValue(
const std::optional<parser::KindSelector> &kind) {
if (kind) {
if (auto *intExpr{std::get_if<parser::ScalarIntConstantExpr>(&kind->u)}) {
const parser::Expr &expr{*intExpr->thing.thing.thing};
if (auto *lit{std::get_if<parser::LiteralConstant>(&expr.u)}) {
if (auto *intLit{std::get_if<parser::IntLiteralConstant>(&lit->u)}) {
- return KindParamValue{
- IntConst::Make(std::get<std::uint64_t>(intLit->t))};
+ return std::get<std::uint64_t>(intLit->t);
}
}
CHECK(!"TODO: constant evaluation");
CHECK(!"TODO: translate star-size to kind");
}
}
- return KindParamValue{};
+ return 0;
}
// MessageHandler implementation
// limitations under the License.
#include "type.h"
-#include "attr.h"
#include "scope.h"
#include "symbol.h"
-#include "../common/idioms.h"
-#include <iostream>
-#include <set>
+#include "../evaluate/type.h"
+#include "../parser/characters.h"
namespace Fortran::semantics {
std::unordered_map<std::uint64_t, IntConst> IntConst::cache;
-std::ostream &operator<<(std::ostream &o, const KindParamValue &x) {
- return o << x.value_;
-}
-
const IntConst &IntConst::Make(std::uint64_t value) {
auto it{cache.find(value)};
if (it == cache.end()) {
return it->second;
}
-std::ostream &operator<<(std::ostream &o, const TypeSpec &x) {
- return x.Output(o);
-}
-
-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);
-}
-
-std::ostream &operator<<(std::ostream &o, const CharacterTypeSpec &x) {
- o << "CHARACTER(" << x.len_;
- if (x.kind_ != CharacterTypeSpec::DefaultKind) {
- o << ", " << x.kind_;
- }
- return o << ')';
-}
-
-std::ostream &operator<<(std::ostream &o, const DerivedTypeDef &x) {
- o << "TYPE";
- if (!x.data_.attrs.empty()) {
- o << ", " << x.data_.attrs;
- }
- o << " :: " << x.data_.name->ToString();
- if (x.data_.lenParams.size() > 0 || x.data_.kindParams.size() > 0) {
- o << '(';
- int n = 0;
- for (const auto ¶m : x.data_.lenParams) {
- if (n++) {
- o << ", ";
- }
- o << param.name();
- }
- for (auto param : x.data_.kindParams) {
- if (n++) {
- o << ", ";
- }
- o << param.name();
- }
- o << ')';
- }
- o << '\n';
- for (const auto ¶m : x.data_.lenParams) {
- o << " " << param.type() << ", LEN :: " << param.name() << "\n";
- }
- for (const auto ¶m : x.data_.kindParams) {
- o << " " << param.type() << ", KIND :: " << param.name() << "\n";
- }
- if (x.data_.Private) {
- o << " PRIVATE\n";
- }
- if (x.data_.sequence) {
- o << " SEQUENCE\n";
- }
- for (const auto &comp : x.data_.dataComps) {
- o << " " << comp << "\n";
- }
- for (const auto &comp : x.data_.procComps) {
- o << " " << comp << "\n";
- }
- if (x.data_.hasTbpPart()) {
- o << "CONTAINS\n";
- if (x.data_.bindingPrivate) {
- o << " PRIVATE\n";
- }
- for (const auto &tbp : x.data_.typeBoundProcs) {
- o << " " << tbp << "\n";
- }
- for (const auto &tbg : x.data_.typeBoundGenerics) {
- o << " " << tbg << "\n";
- }
- for (const auto &name : x.data_.finalProcs) {
- o << " FINAL :: " << name.ToString() << '\n';
- }
- }
- return o << "END TYPE";
-}
-
-// DerivedTypeSpec is a base class for classes with virtual functions,
-// so clang wants it to have a virtual destructor.
-DerivedTypeSpec::~DerivedTypeSpec() {}
-
void DerivedTypeSpec::set_scope(const Scope &scope) {
CHECK(!scope_);
CHECK(scope.kind() == Scope::Kind::DerivedType);
return o;
}
-std::ostream &operator<<(std::ostream &o, const DataComponentDef &x) {
- o << x.type_;
- if (!x.attrs_.empty()) {
- o << ", " << x.attrs_;
- }
- o << " :: " << x.name_.ToString();
- if (!x.arraySpec_.empty()) {
- o << '(';
- int n = 0;
- for (ShapeSpec shape : x.arraySpec_) {
- if (n++) {
- o << ", ";
- }
- o << shape;
- }
- o << ')';
+IntrinsicTypeSpec::IntrinsicTypeSpec(TypeCategory category, int kind)
+ : category_{category}, kind_{kind ? kind : GetDefaultKind(category)} {
+ CHECK(category != TypeCategory::Derived);
+}
+
+int IntrinsicTypeSpec::GetDefaultKind(TypeCategory category) {
+ switch (category) {
+ case TypeCategory::Character: return evaluate::DefaultCharacter::kind;
+ //case TypeCategory::Complex: return evaluate::DefaultComplex::kind;
+ case TypeCategory::Complex: return 4; // TEMP to work around bug
+ case TypeCategory::Integer: return evaluate::DefaultInteger::kind;
+ case TypeCategory::Logical: return evaluate::DefaultLogical::kind;
+ case TypeCategory::Real: return evaluate::DefaultReal::kind;
+ default: CRASH_NO_CASE;
}
- return o;
}
-DataComponentDef::DataComponentDef(const DeclTypeSpec &type,
- const SourceName &name, const Attrs &attrs, const ArraySpec &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 (const auto &shapeSpec : arraySpec) {
- CHECK(shapeSpec.isDeferred());
- }
- } else {
- for (const auto &shapeSpec : arraySpec) {
- CHECK(shapeSpec.isExplicit());
- }
+std::ostream &operator<<(std::ostream &os, const IntrinsicTypeSpec &x) {
+ os << parser::ToUpperCaseLetters(common::EnumToString(x.category()));
+ if (x.kind() != 0) {
+ os << '(' << x.kind() << ')';
}
+ return os;
}
DeclTypeSpec::DeclTypeSpec(const IntrinsicTypeSpec &intrinsic)
- : category_{Intrinsic} {
- typeSpec_.intrinsic = &intrinsic;
-}
+ : category_{Intrinsic}, typeSpec_{intrinsic} {}
DeclTypeSpec::DeclTypeSpec(Category category, DerivedTypeSpec &derived)
- : category_{category} {
+ : category_{category}, typeSpec_{&derived} {
CHECK(category == TypeDerived || category == ClassDerived);
- typeSpec_.derived = &derived;
}
DeclTypeSpec::DeclTypeSpec(Category category) : category_{category} {
CHECK(category == TypeStar || category == ClassStar);
}
const IntrinsicTypeSpec &DeclTypeSpec::intrinsicTypeSpec() const {
CHECK(category_ == Intrinsic);
- return *typeSpec_.intrinsic;
+ return typeSpec_.intrinsic;
}
DerivedTypeSpec &DeclTypeSpec::derivedTypeSpec() {
CHECK(category_ == TypeDerived || category_ == ClassDerived);
CHECK(category_ == TypeDerived || category_ == ClassDerived);
return *typeSpec_.derived;
}
+bool DeclTypeSpec::operator==(const DeclTypeSpec &that) const {
+ if (category_ != that.category_) {
+ return false;
+ }
+ switch (category_) {
+ case Intrinsic: return typeSpec_.intrinsic == that.typeSpec_.intrinsic;
+ case TypeDerived:
+ case ClassDerived: return typeSpec_.derived == that.typeSpec_.derived;
+ default: return true;
+ }
+}
std::ostream &operator<<(std::ostream &o, const DeclTypeSpec &x) {
switch (x.category()) {
- case DeclTypeSpec::Intrinsic: return x.intrinsicTypeSpec().Output(o);
+ case DeclTypeSpec::Intrinsic: return o << x.intrinsicTypeSpec();
case DeclTypeSpec::TypeDerived:
return o << "TYPE(" << x.derivedTypeSpec().name().ToString() << ')';
case DeclTypeSpec::ClassDerived:
type_ = type;
}
-std::ostream &operator<<(std::ostream &o, const ProcDecl &x) {
- return o << x.name_.ToString();
-}
-
-ProcComponentDef::ProcComponentDef(
- const ProcDecl &decl, Attrs attrs, const ProcInterface &interface)
- : decl_{decl}, attrs_{attrs}, interface_{interface} {
- CHECK(attrs_.test(Attr::POINTER));
- attrs_.CheckValid(
- {Attr::PUBLIC, Attr::PRIVATE, Attr::NOPASS, Attr::POINTER, Attr::PASS});
-}
-std::ostream &operator<<(std::ostream &o, const ProcComponentDef &x) {
- o << "PROCEDURE(";
- if (auto *symbol{x.interface_.symbol()}) {
- o << symbol->name().ToString();
- } else if (auto *type{x.interface_.type()}) {
- o << *type;
- }
- o << "), " << x.attrs_ << " :: " << x.decl_;
- return o;
-}
-
std::ostream &operator<<(std::ostream &o, const GenericSpec &x) {
switch (x.kind()) {
case GenericSpec::GENERIC_NAME: return o << x.genericName().ToString();
}
}
-std::ostream &operator<<(std::ostream &o, const TypeBoundProc &x) {
- o << "PROCEDURE(";
- if (x.interface_) {
- o << x.interface_->ToString();
- }
- o << ")";
- if (!x.attrs_.empty()) {
- o << ", " << x.attrs_;
- }
- o << " :: " << x.binding_.ToString();
- if (x.procedure_ != x.binding_) {
- o << " => " << x.procedure_.ToString();
- }
- return o;
-}
-std::ostream &operator<<(std::ostream &o, const TypeBoundGeneric &x) {
- o << "GENERIC ";
- if (!x.attrs_.empty()) {
- o << ", " << x.attrs_;
- }
- o << " :: " << x.genericSpec_ << " => " << x.name_.ToString();
- return o;
-}
-
} // namespace Fortran::semantics
#define FORTRAN_SEMANTICS_TYPE_H_
#include "attr.h"
+#include "../common/fortran.h"
#include "../common/idioms.h"
#include "../parser/char-block.h"
#include <list>
-#include <map>
#include <memory>
#include <optional>
#include <ostream>
-#include <sstream>
#include <string>
#include <unordered_map>
-/*
-
-Type specs are represented by a class hierarchy rooted at TypeSpec. Only the
-leaves are concrete types:
- TypeSpec
- IntrinsicTypeSpec
- CharacterTypeSpec
- LogicalTypeSpec
- NumericTypeSpec
- IntegerTypeSpec
- RealTypeSpec
- ComplexTypeSpec
- DerivedTypeSpec
-
-TypeSpec classes are immutable. For intrinsic types (except character) there
-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.
-
-*/
-
namespace Fortran::semantics {
-using Name = std::string;
+class Scope;
+class Symbol;
/// A SourceName is a name in the cooked character stream,
/// i.e. a range of lower-case characters with provenance.
using SourceName = parser::CharBlock;
+using TypeCategory = common::TypeCategory;
+
// TODO
class IntExpr {
public:
friend std::ostream &operator<<(std::ostream &, const IntConst &);
};
-// The value of a kind type parameter
-class KindParamValue {
-public:
- KindParamValue(int value = 0) : KindParamValue(IntConst::Make(value)) {}
- KindParamValue(const IntConst &value) : value_{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_; }
- const IntConst &value() const { return value_; }
-
-private:
- const IntConst &value_;
- friend std::ostream &operator<<(std::ostream &, const KindParamValue &);
-};
-
// An array spec bound: an explicit integer expression or ASSUMED or DEFERRED
class Bound {
public:
friend std::ostream &operator<<(std::ostream &, const Bound &);
};
-// The value of a len type parameter
-using LenParamValue = Bound;
-
-class IntrinsicTypeSpec;
-class DerivedTypeSpec;
-
-class DeclTypeSpec {
-public:
- enum Category { Intrinsic, TypeDerived, ClassDerived, TypeStar, ClassStar };
-
- // intrinsic-type-spec or TYPE(intrinsic-type-spec)
- DeclTypeSpec(const IntrinsicTypeSpec &);
- // TYPE(derived-type-spec) or CLASS(derived-type-spec)
- DeclTypeSpec(Category, DerivedTypeSpec &);
- // TYPE(*) or CLASS(*)
- DeclTypeSpec(Category);
- DeclTypeSpec() = delete;
-
- bool operator==(const DeclTypeSpec &that) const {
- if (category_ != that.category_) {
- return false;
- }
- switch (category_) {
- case Intrinsic: return typeSpec_.intrinsic == that.typeSpec_.intrinsic;
- case TypeDerived:
- case ClassDerived: return typeSpec_.derived == that.typeSpec_.derived;
- default: return true;
- }
- }
- bool operator!=(const DeclTypeSpec &that) const { return !operator==(that); }
-
- Category category() const { return category_; }
- const IntrinsicTypeSpec &intrinsicTypeSpec() const;
- DerivedTypeSpec &derivedTypeSpec();
- const DerivedTypeSpec &derivedTypeSpec() const;
-
-private:
- Category category_;
- union {
- const IntrinsicTypeSpec *intrinsic;
- DerivedTypeSpec *derived;
- } typeSpec_;
-};
-std::ostream &operator<<(std::ostream &, const DeclTypeSpec &);
-
-// Root of the *TypeSpec hierarchy
-class TypeSpec {
-public:
- virtual std::ostream &Output(std::ostream &o) const = 0;
-};
-
-class IntrinsicTypeSpec : public TypeSpec {
+class IntrinsicTypeSpec {
public:
- const KindParamValue &kind() const { return kind_; }
-
-protected:
- IntrinsicTypeSpec(KindParamValue kind) : kind_{kind} {}
- const KindParamValue kind_;
-};
-
-class NumericTypeSpec : public IntrinsicTypeSpec {
-protected:
- NumericTypeSpec(KindParamValue kind) : IntrinsicTypeSpec(kind) {}
-};
-
-namespace {
-
-// Helper to cache mapping of kind to TypeSpec
-template<typename T> class KindedTypeHelper {
-public:
- std::map<KindParamValue, T> cache;
- KindedTypeHelper(Name name, KindParamValue defaultValue)
- : name_{name}, defaultValue_{defaultValue} {}
- const T &Make() { return Make(defaultValue_); }
- const T &Make(KindParamValue kind) {
- auto it{cache.find(kind)};
- if (it == cache.end()) {
- it = cache.insert(std::make_pair(kind, T{kind})).first;
- }
- return it->second;
- }
- std::ostream &Output(std::ostream &o, const T &x) {
- o << name_;
- if (x.kind_ != defaultValue_) o << '(' << x.kind_ << ')';
- return o;
+ IntrinsicTypeSpec(TypeCategory, int kind = 0);
+ const TypeCategory category() const { return category_; }
+ const int kind() const { return kind_; }
+ bool operator==(const IntrinsicTypeSpec &x) const {
+ return category_ == x.category_ && kind_ == x.kind_;
}
+ bool operator!=(const IntrinsicTypeSpec &x) const { return !operator==(x); }
-private:
- const Name name_;
- const KindParamValue defaultValue_;
-};
-
-} // namespace
-
-// One unique instance of LogicalTypeSpec for each kind.
-class LogicalTypeSpec : public IntrinsicTypeSpec {
-public:
- 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>;
- static KindedTypeHelper<LogicalTypeSpec> helper;
- LogicalTypeSpec(KindParamValue kind) : IntrinsicTypeSpec(kind) {}
- friend std::ostream &operator<<(std::ostream &o, const LogicalTypeSpec &x);
-};
-
-// One unique instance of IntegerTypeSpec for each kind.
-class IntegerTypeSpec : public NumericTypeSpec {
-public:
- static const IntegerTypeSpec &Make();
- static const IntegerTypeSpec &Make(KindParamValue kind);
- std::ostream &Output(std::ostream &o) const override { return o << *this; }
+ static int GetDefaultKind(TypeCategory category);
private:
- friend class KindedTypeHelper<IntegerTypeSpec>;
- static KindedTypeHelper<IntegerTypeSpec> helper;
- IntegerTypeSpec(KindParamValue kind) : NumericTypeSpec(kind) {}
- friend std::ostream &operator<<(std::ostream &o, const IntegerTypeSpec &x);
+ TypeCategory category_;
+ int kind_;
+ friend std::ostream &operator<<(std::ostream &os, const IntrinsicTypeSpec &x);
+ // TODO: Character and len
};
-// One unique instance of RealTypeSpec for each kind.
-class RealTypeSpec : public NumericTypeSpec {
-public:
- 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>;
- static KindedTypeHelper<RealTypeSpec> helper;
- RealTypeSpec(KindParamValue kind) : NumericTypeSpec(kind) {}
- friend std::ostream &operator<<(std::ostream &o, const RealTypeSpec &x);
-};
-
-// One unique instance of ComplexTypeSpec for each kind.
-class ComplexTypeSpec : public NumericTypeSpec {
-public:
- 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 KindedTypeHelper<ComplexTypeSpec> helper;
- ComplexTypeSpec(KindParamValue kind) : NumericTypeSpec(kind) {}
- friend std::ostream &operator<<(std::ostream &o, const ComplexTypeSpec &x);
-};
-
-class CharacterTypeSpec : public IntrinsicTypeSpec {
-public:
- static const int DefaultKind = 0;
- CharacterTypeSpec(LenParamValue len, KindParamValue kind = DefaultKind)
- : IntrinsicTypeSpec{kind}, len_{len} {}
- const LenParamValue &len() const { return len_; }
- std::ostream &Output(std::ostream &o) const override { return o << *this; }
-
-private:
- const LenParamValue len_;
- friend std::ostream &operator<<(std::ostream &, const CharacterTypeSpec &);
-};
-
-// Definition of a type parameter
-class TypeParamDef {
-public:
- TypeParamDef(const Name &name, const IntegerTypeSpec &type,
- const std::optional<IntConst> &defaultValue = {})
- : name_{name}, type_{type}, defaultValue_{defaultValue} {};
- const Name &name() const { return name_; }
- const IntegerTypeSpec &type() const { return type_; }
- const std::optional<IntConst> &defaultValue() const { return defaultValue_; }
-
-private:
- const Name name_;
- const IntegerTypeSpec type_;
- const std::optional<IntConst> defaultValue_;
-};
-
-using TypeParamDefs = std::list<TypeParamDef>;
-
class ShapeSpec {
public:
// lb:ub
using ArraySpec = 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 SourceName &name, const Attrs &attrs)
- : DataComponentDef(type, name, attrs, ArraySpec{}) {}
- DataComponentDef(const DeclTypeSpec &type, const SourceName &name,
- const Attrs &attrs, const ArraySpec &arraySpec);
-
- const DeclTypeSpec &type() const { return type_; }
- const SourceName &name() const { return name_; }
- const Attrs &attrs() const { return attrs_; }
- const ArraySpec &shape() const { return arraySpec_; }
-
-private:
- const DeclTypeSpec type_;
- const SourceName name_;
- const Attrs attrs_;
- const ArraySpec arraySpec_;
- friend std::ostream &operator<<(std::ostream &, const DataComponentDef &);
-};
-
-class Scope;
-class Symbol;
-
-// This represents a proc-interface in the declaration of a procedure or
-// procedure component. It comprises a symbol (representing the specific
-// interface), a decl-type-spec (representing the function return type),
-// or neither.
-class ProcInterface {
-public:
- const Symbol *symbol() const { return symbol_; }
- const DeclTypeSpec *type() const { return type_ ? &*type_ : nullptr; }
- void set_symbol(const Symbol &symbol);
- void set_type(const DeclTypeSpec &type);
-
-private:
- const Symbol *symbol_{nullptr};
- std::optional<DeclTypeSpec> type_;
-};
-
-class ProcDecl {
-public:
- ProcDecl(const ProcDecl &decl) = default;
- ProcDecl(const SourceName &name) : name_{name} {}
- // TODO: proc-pointer-init
- const SourceName &name() const { return name_; }
-
-private:
- const SourceName name_;
- friend std::ostream &operator<<(std::ostream &, const ProcDecl &);
-};
-
-class ProcComponentDef {
-public:
- ProcComponentDef(
- const ProcDecl &decl, Attrs attrs, const ProcInterface &interface);
-
- const ProcDecl &decl() const { return decl_; }
- const Attrs &attrs() const { return attrs_; }
- const ProcInterface &interface() const { return interface_; }
-
-private:
- const ProcDecl decl_;
- const Attrs attrs_;
- const ProcInterface interface_;
- friend std::ostream &operator<<(std::ostream &, const ProcComponentDef &);
-};
-
class GenericSpec {
public:
enum Kind {
friend std::ostream &operator<<(std::ostream &, const GenericSpec &);
};
-class TypeBoundGeneric {
-public:
- TypeBoundGeneric(const SourceName &name, const Attrs &attrs,
- const GenericSpec &genericSpec)
- : name_{name}, attrs_{attrs}, genericSpec_{genericSpec} {
- attrs_.CheckValid({Attr::PUBLIC, Attr::PRIVATE});
- }
-
-private:
- const SourceName name_;
- const Attrs attrs_;
- const GenericSpec genericSpec_;
- friend std::ostream &operator<<(std::ostream &, const TypeBoundGeneric &);
-};
-
-class TypeBoundProc {
-public:
- TypeBoundProc(const SourceName &interface, const Attrs &attrs,
- const SourceName &binding)
- : TypeBoundProc(interface, attrs, binding, binding) {
- if (!attrs_.test(Attr::DEFERRED)) {
- common::die(
- "DEFERRED attribute is required if interface name is specified");
- }
- }
- TypeBoundProc(const Attrs &attrs, const SourceName &binding,
- const std::optional<SourceName> &procedure)
- : TypeBoundProc({}, attrs, binding, procedure ? *procedure : binding) {
- if (attrs_.test(Attr::DEFERRED)) {
- common::die("DEFERRED attribute is only allowed with interface name");
- }
- }
-
-private:
- TypeBoundProc(const std::optional<SourceName> &interface, const Attrs &attrs,
- const SourceName &binding, const SourceName &procedure)
- : interface_{interface}, attrs_{attrs}, binding_{binding}, procedure_{
- procedure} {
- attrs_.CheckValid({Attr::PUBLIC, Attr::PRIVATE, Attr::NOPASS, Attr::PASS,
- Attr::DEFERRED, Attr::NON_OVERRIDABLE});
- }
- const std::optional<SourceName> interface_;
- const Attrs attrs_;
- const SourceName binding_;
- const SourceName procedure_;
- friend std::ostream &operator<<(std::ostream &, const TypeBoundProc &);
-};
-
-// Definition of a derived type
-class DerivedTypeDef {
-public:
- const SourceName &name() const { return *data_.name; }
- const SourceName *extends() const { return data_.extends; }
- const Attrs &attrs() const { return data_.attrs; }
- 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;
- }
- const std::list<TypeBoundProc> &typeBoundProcs() const {
- return data_.typeBoundProcs;
- }
- const std::list<TypeBoundGeneric> &typeBoundGenerics() const {
- return data_.typeBoundGenerics;
- }
- const std::list<SourceName> finalProcs() const { return data_.finalProcs; }
-
- struct Data {
- const SourceName *name{nullptr};
- const SourceName *extends{nullptr};
- Attrs attrs;
- bool Private{false};
- bool sequence{false};
- TypeParamDefs lenParams;
- TypeParamDefs kindParams;
- std::list<DataComponentDef> dataComps;
- std::list<ProcComponentDef> procComps;
- bool bindingPrivate{false};
- std::list<TypeBoundProc> typeBoundProcs;
- std::list<TypeBoundGeneric> typeBoundGenerics;
- std::list<SourceName> finalProcs;
- bool hasTbpPart() const {
- return !finalProcs.empty() || !typeBoundProcs.empty() ||
- !typeBoundGenerics.empty();
- }
- };
- explicit DerivedTypeDef(const Data &x);
-
-private:
- const Data data_;
- // TODO: type-bound procedures
- friend std::ostream &operator<<(std::ostream &, const DerivedTypeDef &);
-};
+// The value of a len type parameter
+using LenParamValue = Bound;
using ParamValue = LenParamValue;
-class DerivedTypeSpec : public TypeSpec {
+class DerivedTypeSpec {
public:
- std::ostream &Output(std::ostream &o) const override { return o << *this; }
explicit DerivedTypeSpec(const SourceName &name) : name_{&name} {}
DerivedTypeSpec() = delete;
- virtual ~DerivedTypeSpec();
const SourceName &name() const { return *name_; }
const Scope *scope() const { return scope_; }
void set_scope(const Scope &);
friend std::ostream &operator<<(std::ostream &, const DerivedTypeSpec &);
};
+class DeclTypeSpec {
+public:
+ enum Category { Intrinsic, TypeDerived, ClassDerived, TypeStar, ClassStar };
+
+ // intrinsic-type-spec or TYPE(intrinsic-type-spec)
+ DeclTypeSpec(const IntrinsicTypeSpec &);
+ // TYPE(derived-type-spec) or CLASS(derived-type-spec)
+ DeclTypeSpec(Category, DerivedTypeSpec &);
+ // TYPE(*) or CLASS(*)
+ DeclTypeSpec(Category);
+ DeclTypeSpec() = delete;
+
+ bool operator==(const DeclTypeSpec &) const;
+ bool operator!=(const DeclTypeSpec &that) const { return !operator==(that); }
+
+ Category category() const { return category_; }
+ const IntrinsicTypeSpec &intrinsicTypeSpec() const;
+ DerivedTypeSpec &derivedTypeSpec();
+ const DerivedTypeSpec &derivedTypeSpec() const;
+
+private:
+ Category category_;
+ union TypeSpec {
+ TypeSpec() : derived{nullptr} {}
+ TypeSpec(IntrinsicTypeSpec intrinsic) : intrinsic{intrinsic} {}
+ TypeSpec(DerivedTypeSpec *derived) : derived{derived} {}
+ IntrinsicTypeSpec intrinsic;
+ DerivedTypeSpec *derived;
+ } typeSpec_;
+};
+std::ostream &operator<<(std::ostream &, const DeclTypeSpec &);
+
+// This represents a proc-interface in the declaration of a procedure or
+// procedure component. It comprises a symbol (representing the specific
+// interface), a decl-type-spec (representing the function return type),
+// or neither.
+class ProcInterface {
+public:
+ const Symbol *symbol() const { return symbol_; }
+ const DeclTypeSpec *type() const { return type_ ? &*type_ : nullptr; }
+ void set_symbol(const Symbol &symbol);
+ void set_type(const DeclTypeSpec &type);
+
+private:
+ const Symbol *symbol_{nullptr};
+ std::optional<DeclTypeSpec> type_;
+};
+
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_TYPE_H_
projects / platform / upstream / llvm.git / commitdiff