replica
/
hanchenye-llvm-project
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[flang] Simplify representation of intrinsic types 

Intrinsic types are now just a TypeCategory and a int kind. If no kind
is specified the default is used so that every type has an explicit
kind. This caused changes in the expected results of some of the tests.

Add support for "double precision" and "double complex".

Intrinsic types are now stored as values in DeclTypeSpec so none of the
KindedTypeHelper machinery is needed any more.

Eliminate DerivedTypeDef, DataComponentDef, ProcComponentDef,
TypeBoundProc. The components and bindings of a derived type are now
represented by the corresponding Scope.

Original-commit: flang-compiler/f18@4ad8ffb187
Reviewed-on: https://github.com/flang-compiler/f18/pull/182
Tree-same-pre-rewrite: false
This commit is contained in:
Tim Keith 2018-09-11 17:33:42 -07:00
parent 0639ed447d
commit ae3b96456f
23 changed files with 191 additions and 671 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
flang/lib/semantics/resolve-names.cc
View File

@ -176,10 +176,9 @@ private:
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.
@ -731,9 +730,9 @@ std::optional<const DeclTypeSpec> ImplicitRules::GetType(char ch) const {
} 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;
}
@ -889,37 +888,38 @@ void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) {
}
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_
@ -941,15 +941,14 @@ void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) {
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");
@ -957,7 +956,7 @@ KindParamValue DeclTypeSpecVisitor::GetKindParamValue(
CHECK(!"TODO: translate star-size to kind");
}
}
return KindParamValue{};
return 0;
}
// MessageHandler implementation

241
flang/lib/semantics/type.cc
View File

@ -13,12 +13,10 @@
// 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 {
@ -33,10 +31,6 @@ std::ostream &operator<<(std::ostream &o, const IntConst &x) {
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()) {
@ -45,118 +39,6 @@ const IntConst &IntConst::Make(std::uint64_t value) {
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 &param : 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 &param : x.data_.lenParams) {
o << " " << param.type() << ", LEN :: " << param.name() << "\n";
}
for (const auto &param : 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);
@ -197,57 +79,43 @@ 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_.ToString();
if (!x.arraySpec_.empty()) {
o << '(';
int n = 0;
for (ShapeSpec shape : x.arraySpec_) {
if (n++) {
o << ", ";
}
o << shape;
}
o << ')';
}
return o;
IntrinsicTypeSpec::IntrinsicTypeSpec(TypeCategory category, int kind)
: category_{category}, kind_{kind ? kind : GetDefaultKind(category)} {
CHECK(category != TypeCategory::Derived);
}
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());
}
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;
}
}
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);
@ -257,10 +125,21 @@ const DerivedTypeSpec &DeclTypeSpec::derivedTypeSpec() const {
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:
@ -280,28 +159,6 @@ void ProcInterface::set_type(const DeclTypeSpec &type) {
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();
@ -334,28 +191,4 @@ std::ostream &operator<<(std::ostream &o, const GenericSpec &x) {
}
}
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

453
flang/lib/semantics/type.h
View File

@ -16,47 +16,27 @@
#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:
@ -85,21 +65,6 @@ private:
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:
@ -122,186 +87,24 @@ private:
friend std::ostream &operator<<(std::ostream &, const Bound &);
};
// The value of a len type parameter
using LenParamValue = Bound;
class IntrinsicTypeSpec;
class DerivedTypeSpec;
class DeclTypeSpec {
class IntrinsicTypeSpec {
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;
}
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 DeclTypeSpec &that) const { return !operator==(that); }
bool operator!=(const IntrinsicTypeSpec &x) const { return !operator==(x); }
Category category() const { return category_; }
const IntrinsicTypeSpec &intrinsicTypeSpec() const;
DerivedTypeSpec &derivedTypeSpec();
const DerivedTypeSpec &derivedTypeSpec() const;
static int GetDefaultKind(TypeCategory category);
private:
Category category_;
union {
const IntrinsicTypeSpec *intrinsic;
DerivedTypeSpec *derived;
} typeSpec_;
TypeCategory category_;
int kind_;
friend std::ostream &operator<<(std::ostream &os, const IntrinsicTypeSpec &x);
// TODO: Character and len
};
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 {
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;
}
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; }
private:
friend class KindedTypeHelper<IntegerTypeSpec>;
static KindedTypeHelper<IntegerTypeSpec> helper;
IntegerTypeSpec(KindParamValue kind) : NumericTypeSpec(kind) {}
friend std::ostream &operator<<(std::ostream &o, const IntegerTypeSpec &x);
};
// 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:
@ -345,78 +148,6 @@ private:
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 {
@ -473,111 +204,15 @@ private:
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 &);
@ -589,6 +224,54 @@ private:
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_

8
flang/test/semantics/modfile01.f90
View File

@ -27,11 +27,11 @@ end
!Expect: m.mod
!module m
!integer::i
!integer,private::j
!integer(4)::i
!integer(4),private::j
!type::t
!integer::i
!integer,private::j
!integer(4)::i
!integer(4),private::j
!end type
!type,private::u
!end type

4
flang/test/semantics/modfile02.f90
View File

@ -28,10 +28,10 @@ end
!Expect: m.mod
!module m
!type,private::t1
!integer::i
!integer(4)::i
!end type
!type,private::t2
!integer::i
!integer(4)::i
!end type
!type(t1)::x1
!type(t2),private::x2

6
flang/test/semantics/modfile03.f90
View File

@ -35,14 +35,14 @@ end
!Expect: m1.mod
!module m1
!integer::x1
!integer,private::x2
!integer(4)::x1
!integer(4),private::x2
!end
!Expect: m2.mod
!module m2
!use m1,only:x1
!integer::y1
!integer(4)::y1
!end
!Expect: m3.mod

10
flang/test/semantics/modfile04.f90
View File

@ -38,14 +38,14 @@ end
!module m
!contains
!pure subroutine s(x,y) bind(c)
!logical,intent(in)::x
!real,intent(inout)::y
!logical(4),intent(in)::x
!real(4),intent(inout)::y
!end
!function f1() result(x)
!real::x
!real(4)::x
!end
!function f2(y)
!real::f2
!complex::y
!real(4)::f2
!complex(4)::y
!end
!end

6
flang/test/semantics/modfile05.f90
View File

@ -29,9 +29,9 @@ end
!Expect: m1.mod
!module m1
!real::x
!integer::y
!real,volatile::z
!real(4)::x
!integer(4)::y
!real(4),volatile::z
!end
!Expect: m2.mod

8
flang/test/semantics/modfile06.f90
View File

@ -28,14 +28,14 @@ end
!module m
! interface
! function f(x)
! integer::f
! real::x
! integer(4)::f
! real(4)::x
! end
! end interface
! interface
! subroutine s(y,z)
! logical::y
! complex::z
! logical(4)::y
! complex(4)::z
! end
! end interface
!end

8
flang/test/semantics/modfile07.f90
View File

@ -42,20 +42,20 @@ end
! generic::foo=>s1,s2
! interface
! subroutine s1(x)
! real::x
! real(4)::x
! end
! end interface
! interface
! subroutine s2(x)
! complex::x
! complex(4)::x
! end
! end interface
! generic::bar=>s1,s2,s3,s4
!contains
! subroutine s3(x)
! logical::x
! logical(4)::x
! end
! subroutine s4(x)
! integer::x
! integer(4)::x
! end
!end

10
flang/test/semantics/modfile08.f90
View File

@ -35,16 +35,16 @@ end
!Expect: m.mod
!module m
! procedure(real)::a
! procedure(logical)::b
! procedure(complex)::c
! procedure(real(4))::a
! procedure(logical(4))::b
! procedure(complex(4))::c
! procedure()::d
! procedure()::e
! procedure(real)::f
! procedure(real(4))::f
! procedure(s)::g
! type::t
! procedure(),nopass,pointer::e
! procedure(real),nopass,pointer::f
! procedure(real(4)),nopass,pointer::f
! procedure(s),pointer,private::g
! end type
!contains

2
flang/test/semantics/modfile09-a.f90
View File

@ -8,7 +8,7 @@ end
!Expect: m.mod
!module m
!integer::m1_x
!integer(4)::m1_x
!interface
!module subroutine s()
!end

2
flang/test/semantics/modfile09-b.f90
View File

@ -4,5 +4,5 @@ end
!Expect: m-s1.mod
!submodule(m) s1
!integer::s1_x
!integer(4)::s1_x
!end

2
flang/test/semantics/modfile09-c.f90
View File

@ -4,5 +4,5 @@ end
!Expect: m-s2.mod
!submodule(m:s1) s2
!integer::s2_x
!integer(4)::s2_x
!end

2
flang/test/semantics/modfile09-d.f90
View File

@ -4,5 +4,5 @@ end
!Expect: m-s3.mod
!submodule(m:s2) s3
!integer::s3_x
!integer(4)::s3_x
!end

16
flang/test/semantics/modfile10.f90
View File

@ -38,6 +38,8 @@ module m
sequence
integer i
real x
double precision y
double complex z
end type
contains
subroutine b()
@ -58,19 +60,19 @@ end module
!module m
! interface
! subroutine a(i,j)
! integer::i
! integer::j
! integer(4)::i
! integer(4)::j
! end
! end interface
! type,abstract::t
! integer::i
! integer(4)::i
! contains
! procedure(a),deferred,nopass::q
! procedure(b),deferred,nopass::p
! procedure(b),deferred,nopass::r
! end type
! type::t2
! integer::x
! integer(4)::x
! contains
! final::c
! procedure,non_overridable,private::d
@ -78,8 +80,10 @@ end module
! end type
! type::t3
! sequence
! integer::i
! real::x
! integer(4)::i
! real(4)::x
! real(8)::y
! complex(8)::z
! end type
!contains
! subroutine b()

6
flang/test/semantics/modfile11.f90
View File

@ -28,13 +28,13 @@ end
!Expect: m.mod
!module m
! type::t1(a,b,c)
! integer,kind::a
! integer(4),kind::a
! integer(8),len::b
! integer(8),len::c
! integer::d
! integer(4)::d
! end type
! type,extends(t1)::t2(e)
! integer,len::e
! integer(4),len::e
! end type
! type,bind(c),extends(t2)::t3
! end type

6
flang/test/semantics/symbol01.f90
View File

@ -20,8 +20,8 @@ module m
private :: f
contains
!DEF: /m/s BIND(C), PUBLIC, PURE Subprogram
!DEF: /m/s/x INTENT(IN) (implicit) ObjectEntity REAL
!DEF: /m/s/y INTENT(INOUT) (implicit) ObjectEntity REAL
!DEF: /m/s/x INTENT(IN) (implicit) ObjectEntity REAL(4)
!DEF: /m/s/y INTENT(INOUT) (implicit) ObjectEntity REAL(4)
pure subroutine s (x, y) bind(c)
intent(in) :: x
intent(inout) :: y
@ -31,7 +31,7 @@ contains
end subroutine
end subroutine
!DEF: /m/f PRIVATE, PURE, RECURSIVE Subprogram
!DEF: /m/f/x ALLOCATABLE ObjectEntity REAL
!DEF: /m/f/x ALLOCATABLE ObjectEntity REAL(4)
recursive pure function f() result(x)
real, allocatable :: x
!REF: /m/f/x

4
flang/test/semantics/symbol03.f90
View File

@ -16,14 +16,14 @@
!DEF: /main MainProgram
program main
!DEF: /main/x ObjectEntity INTEGER
!DEF: /main/x ObjectEntity INTEGER(4)
integer x
!REF: /main/s
call s
contains
!DEF: /main/s Subprogram
subroutine s
!DEF: /main/s/y (implicit) ObjectEntity REAL
!DEF: /main/s/y (implicit) ObjectEntity REAL(4)
!REF: /main/x
y = x
end subroutine

2
flang/test/semantics/symbol04.f90
View File

@ -21,7 +21,7 @@ module m
end type
!DEF: /m/t2 PUBLIC DerivedType
type :: t2
!DEF: /m/t2/t1 ObjectEntity INTEGER
!DEF: /m/t2/t1 ObjectEntity INTEGER(4)
integer :: t1
!DEF: /m/t2/x ObjectEntity TYPE(t1)
!REF: /m/t1

26
flang/test/semantics/symbol05.f90
View File

@ -16,10 +16,10 @@
!DEF: /s1 Subprogram
subroutine s1
!DEF: /s1/x ObjectEntity INTEGER
!DEF: /s1/x ObjectEntity INTEGER(4)
integer x
block
!DEF: /s1/Block1/y ObjectEntity INTEGER
!DEF: /s1/Block1/y ObjectEntity INTEGER(4)
integer y
!REF: /s1/x
x = 1
@ -27,7 +27,7 @@ subroutine s1
y = 2.0
end block
block
!DEF: /s1/Block2/y ObjectEntity REAL
!DEF: /s1/Block2/y ObjectEntity REAL(4)
real y
!REF: /s1/Block2/y
y = 3.0
@ -38,9 +38,9 @@ end subroutine
subroutine s2
implicit integer(w-x)
block
!DEF: /s2/x (implicit) ObjectEntity INTEGER
!DEF: /s2/x (implicit) ObjectEntity INTEGER(4)
x = 1
!DEF: /s2/y (implicit) ObjectEntity REAL
!DEF: /s2/y (implicit) ObjectEntity REAL(4)
y = 2
end block
contains
@ -48,7 +48,7 @@ contains
subroutine s
!REF: /s2/x
x = 1
!DEF: /s2/s/w (implicit) ObjectEntity INTEGER
!DEF: /s2/s/w (implicit) ObjectEntity INTEGER(4)
w = 1
end subroutine
end subroutine
@ -58,8 +58,8 @@ subroutine s3
block
!DEF: /s3/Block1/t DerivedType
type :: t
!DEF: /s3/i (implicit) ObjectEntity INTEGER
!DEF: /s3/Block1/t/x ObjectEntity REAL
!DEF: /s3/i (implicit) ObjectEntity INTEGER(4)
!DEF: /s3/Block1/t/x ObjectEntity REAL(4)
real :: x(10) = [(i, i=1,10)]
end type
end block
@ -70,8 +70,8 @@ subroutine s4
implicit integer(x)
interface
!DEF: /s4/s EXTERNAL Subprogram
!DEF: /s4/s/x (implicit) ObjectEntity REAL
!DEF: /s4/s/y (implicit) ObjectEntity INTEGER
!DEF: /s4/s/x (implicit) ObjectEntity REAL(4)
!DEF: /s4/s/y (implicit) ObjectEntity INTEGER(4)
subroutine s (x, y)
implicit integer(y)
end subroutine
@ -81,13 +81,13 @@ end subroutine
!DEF: /s5 Subprogram
subroutine s5
block
!DEF: /s5/Block1/x (implicit) ObjectEntity REAL
!DEF: /s5/Block1/x (implicit) ObjectEntity REAL(4)
dimension :: x(2)
block
!DEF: /s5/Block1/Block1/x (implicit) ObjectEntity REAL
!DEF: /s5/Block1/Block1/x (implicit) ObjectEntity REAL(4)
dimension :: x(3)
end block
end block
!DEF: /s5/x (implicit) ObjectEntity REAL
!DEF: /s5/x (implicit) ObjectEntity REAL(4)
x = 1.0
end subroutine

2
flang/test/semantics/test_modfile.sh
View File

@ -61,7 +61,7 @@ for src in "$@"; do
fi
sed '/^!mod\$/d' $temp/$mod > $actual
sed '1,/^!Expect: '"$mod"'/d' $src | sed -e '/^$/,$d' -e 's/^! *//' > $expect
if ! diff -U999999 $actual $expect > $diffs; then
if ! diff -U999999 $expect $actual > $diffs; then
echo "Module file $mod differs from expected:"
sed '1,2d' $diffs
echo FAIL

3
flang/tools/f18/dump.cc
View File

@ -40,7 +40,8 @@ DEFINE_DUMP(parser, Name)
DEFINE_DUMP(parser, CharBlock)
DEFINE_DUMP(semantics, Symbol)
DEFINE_DUMP(semantics, Scope)
DEFINE_DUMP(semantics, TypeSpec)
DEFINE_DUMP(semantics, IntrinsicTypeSpec)
DEFINE_DUMP(semantics, DerivedTypeSpec)
DEFINE_DUMP(semantics, DeclTypeSpec)
} // namespace Fortran