// Provide Post methods to collect attributes into a member variable.
class AttrsVisitor {
public:
- void beginAttrs() {
- CHECK(!attrs_);
- attrs_ = std::make_unique<Attrs>();
- }
- Attrs endAttrs() {
- const auto result = attrs_ ? *attrs_ : Attrs::EMPTY;
- attrs_.reset();
- return result;
- }
+ void beginAttrs();
+ Attrs endAttrs();
+ void Post(const parser::LanguageBindingSpec &x);
+ bool Pre(const parser::AccessSpec &x);
+ bool Pre(const parser::IntentSpec &x);
- void Post(const parser::LanguageBindingSpec &x) {
- attrs_->Set(Attr::BIND_C);
- if (x.v) {
- // TODO: set langBindingName_ from ScalarDefaultCharConstantExpr
- }
- }
- void Post(const parser::PrefixSpec::Elemental &) {
- attrs_->Set(Attr::ELEMENTAL);
- }
- void Post(const parser::PrefixSpec::Impure &) { attrs_->Set(Attr::IMPURE); }
- void Post(const parser::PrefixSpec::Module &) { attrs_->Set(Attr::MODULE); }
- void Post(const parser::PrefixSpec::Non_Recursive &) {
- attrs_->Set(Attr::NON_RECURSIVE);
- }
- void Post(const parser::PrefixSpec::Pure &) { attrs_->Set(Attr::PURE); }
- void Post(const parser::PrefixSpec::Recursive &) {
- attrs_->Set(Attr::RECURSIVE);
+// Simple case: encountering CLASSNAME causes ATTRNAME to be set.
+#define HANDLE_ATTR_CLASS(CLASSNAME, ATTRNAME) \
+ bool Pre(const parser::CLASSNAME &) { \
+ attrs_->Set(Attr::ATTRNAME); \
+ return false; \
}
+ HANDLE_ATTR_CLASS(PrefixSpec::Elemental, ELEMENTAL)
+ HANDLE_ATTR_CLASS(PrefixSpec::Impure, IMPURE)
+ HANDLE_ATTR_CLASS(PrefixSpec::Module, MODULE)
+ HANDLE_ATTR_CLASS(PrefixSpec::Non_Recursive, NON_RECURSIVE)
+ HANDLE_ATTR_CLASS(PrefixSpec::Pure, PURE)
+ HANDLE_ATTR_CLASS(PrefixSpec::Recursive, RECURSIVE)
+ HANDLE_ATTR_CLASS(TypeAttrSpec::BindC, BIND_C)
+ HANDLE_ATTR_CLASS(Abstract, ABSTRACT)
+ HANDLE_ATTR_CLASS(Allocatable, ALLOCATABLE)
+ HANDLE_ATTR_CLASS(Asynchronous, ASYNCHRONOUS)
+ HANDLE_ATTR_CLASS(Contiguous, CONTIGUOUS)
+ HANDLE_ATTR_CLASS(External, EXTERNAL)
+ HANDLE_ATTR_CLASS(Intrinsic, INTRINSIC)
+ HANDLE_ATTR_CLASS(NoPass, NOPASS)
+ HANDLE_ATTR_CLASS(Optional, OPTIONAL)
+ HANDLE_ATTR_CLASS(Parameter, PARAMETER)
+ HANDLE_ATTR_CLASS(Pass, PASS)
+ HANDLE_ATTR_CLASS(Pointer, POINTER)
+ HANDLE_ATTR_CLASS(Protected, PROTECTED)
+ HANDLE_ATTR_CLASS(Save, SAVE)
+ HANDLE_ATTR_CLASS(Target, TARGET)
+ HANDLE_ATTR_CLASS(Value, VALUE)
+ HANDLE_ATTR_CLASS(Volatile, VOLATILE)
+#undef HANDLE_ATTR_CLASS
protected:
std::unique_ptr<Attrs> attrs_;
class DeclTypeSpecVisitor : public AttrsVisitor {
public:
using AttrsVisitor::Post;
-
- void beginDeclTypeSpec() {
- CHECK(!expectDeclTypeSpec_);
- expectDeclTypeSpec_ = true;
- }
- std::optional<DeclTypeSpec> getDeclTypeSpec() {
- return declTypeSpec_ ? *declTypeSpec_.get() : std::optional<DeclTypeSpec>();
- }
- void endDeclTypeSpec() {
- CHECK(expectDeclTypeSpec_);
- expectDeclTypeSpec_ = false;
- declTypeSpec_.reset();
- }
-
- bool Pre(const parser::IntegerTypeSpec &x) {
- MakeIntrinsic(IntegerTypeSpec::Make(GetKindParamValue(x.v)));
- return false;
- }
- bool Pre(const parser::IntrinsicTypeSpec::Logical &x) {
- MakeIntrinsic(LogicalTypeSpec::Make(GetKindParamValue(x.kind)));
- return false;
- }
- bool Pre(const parser::IntrinsicTypeSpec::Real &x) {
- MakeIntrinsic(RealTypeSpec::Make(GetKindParamValue(x.kind)));
- return false;
- }
- bool Pre(const parser::IntrinsicTypeSpec::Complex &x) {
- MakeIntrinsic(ComplexTypeSpec::Make(GetKindParamValue(x.kind)));
- return false;
- }
+ using AttrsVisitor::Pre;
+ void beginDeclTypeSpec();
+ void endDeclTypeSpec();
+ bool Pre(const parser::IntegerTypeSpec &);
+ bool Pre(const parser::IntrinsicTypeSpec::Logical &);
+ bool Pre(const parser::IntrinsicTypeSpec::Real &);
+ bool Pre(const parser::IntrinsicTypeSpec::Complex &);
+ bool Pre(const parser::DeclarationTypeSpec::ClassStar &);
+ bool Pre(const parser::DeclarationTypeSpec::TypeStar &);
+ void Post(const parser::DeclarationTypeSpec::Type &);
+ void Post(const parser::DeclarationTypeSpec::Class &);
+ bool Pre(const parser::DeclarationTypeSpec::Record &);
+ bool Pre(const parser::DerivedTypeSpec &);
+ void Post(const parser::TypeParamSpec &);
+ bool Pre(const parser::TypeParamValue &);
protected:
std::unique_ptr<DeclTypeSpec> declTypeSpec_;
+ std::unique_ptr<DerivedTypeSpec> derivedTypeSpec_;
+ std::unique_ptr<ParamValue> typeParamValue_;
private:
bool expectDeclTypeSpec_{false}; // should only see decl-type-spec when true
-
- void MakeIntrinsic(const IntrinsicTypeSpec *intrinsicTypeSpec) {
- CHECK(expectDeclTypeSpec_ && !declTypeSpec_);
- declTypeSpec_ = std::make_unique<DeclTypeSpec>(
- DeclTypeSpec::MakeIntrinsic(intrinsicTypeSpec));
- }
-
+ void MakeIntrinsic(const IntrinsicTypeSpec &intrinsicTypeSpec);
+ void SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec);
static KindParamValue GetKindParamValue(
- const std::optional<parser::KindSelector> &kind) {
- if (!kind) {
- return KindParamValue();
- } else if (std::holds_alternative<parser::ScalarIntConstantExpr>(kind->u)) {
- const auto &expr = std::get<parser::ScalarIntConstantExpr>(kind->u);
- const auto &lit =
- std::get<parser::LiteralConstant>(expr.thing.thing.thing->u);
- const auto &intlit = std::get<parser::IntLiteralConstant>(lit.u);
- return KindParamValue(std::get<std::uint64_t>(intlit.t));
- } else {
- CHECK(false && "TODO: translate star-size to kind");
- }
- }
+ const std::optional<parser::KindSelector> &kind);
};
// Walk the parse tree and resolve names to symbols.
void PushScope(Scope &scope) { scopes_.push(&scope); }
void PopScope() { scopes_.pop(); }
+ // Default action for a parse tree node is to visit children.
+ template<typename T> bool Pre(const T &) { return true; }
+ template<typename T> void Post(const T &) {}
+
+ bool Pre(const parser::TypeDeclarationStmt &);
+ void Post(const parser::TypeDeclarationStmt &);
+ void Post(const parser::EntityDecl &);
+ bool Pre(const parser::PrefixSpec &);
+ void Post(const parser::EndSubroutineStmt &);
+ void Post(const parser::EndFunctionStmt &);
+ bool Pre(const parser::Suffix &);
+ bool Pre(const parser::SubroutineStmt &);
+ void Post(const parser::SubroutineStmt &);
+ bool Pre(const parser::FunctionStmt &);
+ void Post(const parser::FunctionStmt &);
+ void Post(const parser::Program &);
+
+private:
+ // Stack of containing scopes; memory referenced is owned by parent scopes
+ std::stack<Scope *, std::list<Scope *>> scopes_;
+ std::optional<Name> funcResultName_;
+
+ // Common Post() for functions and subroutines.
+ // Create a symbol in the current scope, push a new scope, add the dummies.
+ void PostSubprogram(const Name &name, const std::list<Name> &dummyNames);
+
// Helpers to make a Symbol in the current scope
- template<typename D>
- Symbol &MakeSymbol(const Name &name, D &&details) {
+ template<typename D> Symbol &MakeSymbol(const Name &name, D &&details) {
return CurrScope().MakeSymbol(name, details);
}
template<typename D>
Symbol &MakeSymbol(const Name &name, const Attrs &attrs, D &&details) {
return CurrScope().MakeSymbol(name, attrs, details);
}
+};
- // Default action for a parse tree node is to visit children.
- template<typename T> bool Pre(const T &x) { return true; }
- template<typename T> void Post(const T &) {}
-
- bool Pre(const parser::TypeDeclarationStmt &x) {
- beginDeclTypeSpec();
- beginAttrs();
- return true;
+// AttrsVisitor implementation
+void AttrsVisitor::beginAttrs() {
+ CHECK(!attrs_);
+ attrs_ = std::make_unique<Attrs>();
+}
+Attrs AttrsVisitor::endAttrs() {
+ const auto result = attrs_ ? *attrs_ : Attrs::EMPTY;
+ attrs_.reset();
+ return result;
+}
+void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) {
+ attrs_->Set(Attr::BIND_C);
+ if (x.v) {
+ // TODO: set langBindingName_ from ScalarDefaultCharConstantExpr
}
- void Post(const parser::TypeDeclarationStmt &x) {
- endDeclTypeSpec();
- endAttrs();
+}
+bool AttrsVisitor::Pre(const parser::AccessSpec &x) {
+ switch (x.v) {
+ case parser::AccessSpec::Kind::Public: attrs_->Set(Attr::PUBLIC); break;
+ case parser::AccessSpec::Kind::Private: attrs_->Set(Attr::PRIVATE); break;
+ default: CRASH_NO_CASE;
+ }
+ return false;
+}
+bool AttrsVisitor::Pre(const parser::IntentSpec &x) {
+ switch (x.v) {
+ case parser::IntentSpec::Intent::In:
+ attrs_->Set(Attr::INTENT_IN);
+ break;
+ case parser::IntentSpec::Intent::Out:
+ attrs_->Set(Attr::INTENT_OUT);
+ break;
+ case parser::IntentSpec::Intent::InOut:
+ attrs_->Set(Attr::INTENT_IN);
+ attrs_->Set(Attr::INTENT_OUT);
+ break;
+ default: CRASH_NO_CASE;
}
+ return false;
+}
- void Post(const parser::EntityDecl &x) {
- // TODO: may be under StructureStmt
- const auto &name = std::get<parser::ObjectName>(x.t);
- // TODO: optional ArraySpec, CoarraySpec, CharLength, Initialization
- Symbol &symbol = CurrScope().GetOrMakeSymbol(name.ToString());
- if (symbol.has<UnknownDetails>()) {
- symbol.set_details(EntityDetails());
- } else if (EntityDetails *details = symbol.detailsIf<EntityDetails>()) {
- if (details->type().has_value()) {
- std::cerr << "ERROR: symbol already has a type declared: "
- << name.ToString() << "\n";
- } else {
- details->set_type(*declTypeSpec_);
- }
- } else {
- std::cerr
- << "ERROR: symbol already declared, can't appear in entity-decl: "
- << name.ToString() << "\n";
- }
+// DeclTypeSpecVisitor implementation
+void DeclTypeSpecVisitor::beginDeclTypeSpec() {
+ CHECK(!expectDeclTypeSpec_);
+ expectDeclTypeSpec_ = true;
+}
+void DeclTypeSpecVisitor::endDeclTypeSpec() {
+ CHECK(expectDeclTypeSpec_);
+ expectDeclTypeSpec_ = false;
+ declTypeSpec_.reset();
+}
+
+bool DeclTypeSpecVisitor::Pre(const parser::DeclarationTypeSpec::ClassStar &x) {
+ SetDeclTypeSpec(DeclTypeSpec::MakeClassStar());
+ return false;
+}
+bool DeclTypeSpecVisitor::Pre(const parser::DeclarationTypeSpec::TypeStar &x) {
+ SetDeclTypeSpec(DeclTypeSpec::MakeTypeStar());
+ return false;
+}
+bool DeclTypeSpecVisitor::Pre(const parser::DerivedTypeSpec &x) {
+ CHECK(!derivedTypeSpec_);
+ derivedTypeSpec_ =
+ std::make_unique<DerivedTypeSpec>(std::get<parser::Name>(x.t).ToString());
+ return true;
+}
+void DeclTypeSpecVisitor::Post(const parser::TypeParamSpec &x) {
+ if (const auto &keyword = std::get<std::optional<parser::Keyword>>(x.t)) {
+ derivedTypeSpec_->AddParamValue(keyword->v.ToString(), *typeParamValue_);
+ } else {
+ derivedTypeSpec_->AddParamValue(*typeParamValue_);
}
+ typeParamValue_.reset();
+}
+bool DeclTypeSpecVisitor::Pre(const parser::TypeParamValue &x) {
+ typeParamValue_ = std::make_unique<ParamValue>(
+ std::visit(parser::visitors{
+ [&](const parser::ScalarIntExpr &x) { return Bound{IntExpr{x}}; },
+ [&](const parser::Star &x) { return Bound::ASSUMED; },
+ [&](const parser::TypeParamValue::Deferred &x) { return Bound::DEFERRED; },
+ }, x.u));
+ return false;
+}
- bool Pre(const parser::PrefixSpec &stmt) {
- // TODO
- return true;
+void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::Type &x) {
+ SetDeclTypeSpec(
+ DeclTypeSpec::MakeTypeDerivedType(*derivedTypeSpec_.release()));
+}
+void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::Class &x) {
+ SetDeclTypeSpec(
+ DeclTypeSpec::MakeClassDerivedType(*derivedTypeSpec_.release()));
+}
+bool DeclTypeSpecVisitor::Pre(const parser::DeclarationTypeSpec::Record &x) {
+ // TODO
+ return true;
+}
+bool DeclTypeSpecVisitor::Pre(const parser::IntegerTypeSpec &x) {
+ MakeIntrinsic(IntegerTypeSpec::Make(GetKindParamValue(x.v)));
+ return false;
+}
+bool DeclTypeSpecVisitor::Pre(const parser::IntrinsicTypeSpec::Logical &x) {
+ MakeIntrinsic(LogicalTypeSpec::Make(GetKindParamValue(x.kind)));
+ return false;
+}
+bool DeclTypeSpecVisitor::Pre(const parser::IntrinsicTypeSpec::Real &x) {
+ MakeIntrinsic(RealTypeSpec::Make(GetKindParamValue(x.kind)));
+ return false;
+}
+bool DeclTypeSpecVisitor::Pre(const parser::IntrinsicTypeSpec::Complex &x) {
+ MakeIntrinsic(ComplexTypeSpec::Make(GetKindParamValue(x.kind)));
+ return false;
+}
+void DeclTypeSpecVisitor::MakeIntrinsic(
+ const IntrinsicTypeSpec &intrinsicTypeSpec) {
+ SetDeclTypeSpec(DeclTypeSpec::MakeIntrinsic(intrinsicTypeSpec));
+}
+// Check that we're expecting to see a DeclTypeSpec (and haven't seen one yet)
+// and save it in declTypeSpec_.
+void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) {
+ CHECK(expectDeclTypeSpec_ && !declTypeSpec_);
+ declTypeSpec_ = std::make_unique<DeclTypeSpec>(declTypeSpec);
+}
+
+KindParamValue DeclTypeSpecVisitor::GetKindParamValue(
+ const std::optional<parser::KindSelector> &kind) {
+ if (!kind) {
+ return KindParamValue();
+ } else if (const auto *expr =
+ std::get_if<parser::ScalarIntConstantExpr>(&kind->u)) {
+ const auto &lit =
+ std::get<parser::LiteralConstant>(expr->thing.thing.thing->u);
+ const auto &intlit = std::get<parser::IntLiteralConstant>(lit.u);
+ return KindParamValue(std::get<std::uint64_t>(intlit.t));
+ } else {
+ CHECK(!"TODO: translate star-size to kind");
}
- void Post(const parser::EndFunctionStmt &subp) {
- std::cout << "End of function scope\n";
- std::cout << CurrScope();
- PopScope();
+}
+
+
+// ResolveNamesVisitor implementation
+
+void ResolveNamesVisitor::Post(const parser::EntityDecl &x) {
+ // TODO: may be under StructureStmt
+ const auto &name = std::get<parser::ObjectName>(x.t);
+ // TODO: optional ArraySpec, CoarraySpec, CharLength, Initialization
+ Symbol &symbol = CurrScope().GetOrMakeSymbol(name.ToString());
+ symbol.attrs().Add(*attrs_); //TODO: check attribute consistency
+ if (symbol.has<UnknownDetails>()) {
+ symbol.set_details(EntityDetails());
}
- bool Pre(const parser::Suffix &suffix) {
- if (suffix.resultName.has_value()) {
- funcResultName_ =
- std::make_optional(suffix.resultName->ToString());
+ if (EntityDetails *details = symbol.detailsIf<EntityDetails>()) {
+ if (details->type().has_value()) {
+ std::cerr << "ERROR: symbol already has a type declared: "
+ << name.ToString() << "\n";
+ } else {
+ details->set_type(*declTypeSpec_);
}
- return true;
+ } else {
+ std::cerr
+ << "ERROR: symbol already declared, can't appear in entity-decl: "
+ << name.ToString() << "\n";
}
+}
- bool Pre(const parser::SubroutineStmt &stmt) {
- beginAttrs();
- return true;
- }
+bool ResolveNamesVisitor::Pre(const parser::TypeDeclarationStmt &x) {
+ beginDeclTypeSpec();
+ beginAttrs();
+ return true;
+}
- // Common Post() for functions and subroutines.
- void PostSubprogram(
- const Name &name, const std::list<Name> &dummyNames) {
- const auto attrs = endAttrs();
- MakeSymbol(name, attrs, SubprogramDetails(dummyNames));
- Scope &subpScope = CurrScope().MakeScope(Scope::Kind::Subprogram);
- PushScope(subpScope);
- for (const auto &dummyName : dummyNames) {
- MakeSymbol(dummyName, EntityDetails(true));
- }
+void ResolveNamesVisitor::Post(const parser::TypeDeclarationStmt &x) {
+ endDeclTypeSpec();
+ endAttrs();
+}
+
+bool ResolveNamesVisitor::Pre(const parser::PrefixSpec &stmt) {
+ return true; // TODO
+}
+
+void ResolveNamesVisitor::Post(const parser::EndSubroutineStmt &subp) {
+ std::cout << "End of subroutine scope\n";
+ std::cout << CurrScope();
+ PopScope();
+}
+
+void ResolveNamesVisitor::Post(const parser::EndFunctionStmt &subp) {
+ std::cout << "End of function scope\n";
+ std::cout << CurrScope();
+ PopScope();
+}
+
+bool ResolveNamesVisitor::Pre(const parser::Suffix &suffix) {
+ if (suffix.resultName.has_value()) {
+ funcResultName_ = std::make_optional(suffix.resultName->ToString());
}
+ return true;
+}
- void Post(const parser::SubroutineStmt &stmt) {
- Name subrName = std::get<parser::Name>(stmt.t).ToString();
- std::list<Name> dummyNames;
- const auto &dummyArgs = std::get<std::list<parser::DummyArg>>(stmt.t);
- for (const parser::DummyArg &dummyArg : dummyArgs) {
- const parser::Name *dummyName = std::get_if<parser::Name>(&dummyArg.u);
- CHECK(dummyName != nullptr && "TODO: alternate return indicator");
- dummyNames.push_back(dummyName->ToString());
- }
- PostSubprogram(subrName, dummyNames);
- MakeSymbol(subrName, SubprogramDetails(dummyNames));
+bool ResolveNamesVisitor::Pre(const parser::SubroutineStmt &stmt) {
+ beginAttrs();
+ return true;
+}
+
+void ResolveNamesVisitor::Post(const parser::SubroutineStmt &stmt) {
+ Name subrName = std::get<parser::Name>(stmt.t).ToString();
+ std::list<Name> dummyNames;
+ const auto &dummyArgs = std::get<std::list<parser::DummyArg>>(stmt.t);
+ for (const parser::DummyArg &dummyArg : dummyArgs) {
+ const parser::Name *dummyName = std::get_if<parser::Name>(&dummyArg.u);
+ CHECK(dummyName != nullptr && "TODO: alternate return indicator");
+ dummyNames.push_back(dummyName->ToString());
}
+ PostSubprogram(subrName, dummyNames);
+ MakeSymbol(subrName, SubprogramDetails(dummyNames));
+}
- bool Pre(const parser::FunctionStmt &stmt) {
- beginAttrs();
- beginDeclTypeSpec();
- CHECK(!funcResultName_);
- return true;
+bool ResolveNamesVisitor::Pre(const parser::FunctionStmt &stmt) {
+ beginAttrs();
+ beginDeclTypeSpec();
+ CHECK(!funcResultName_);
+ return true;
+}
+
+void ResolveNamesVisitor::Post(const parser::FunctionStmt &stmt) {
+ Name funcName = std::get<parser::Name>(stmt.t).ToString();
+ std::list<Name> dummyNames;
+ for (const auto &dummy : std::get<std::list<parser::Name>>(stmt.t)) {
+ dummyNames.push_back(dummy.ToString());
}
- // TODO: MakeSymbol function
- void Post(const parser::FunctionStmt &stmt) {
- Name funcName = std::get<parser::Name>(stmt.t).ToString();
- std::list<Name> dummyNames;
- for (const auto &dummy : std::get<std::list<parser::Name>>(stmt.t)) {
- dummyNames.push_back(dummy.ToString());
- }
- PostSubprogram(funcName, dummyNames);
- // add function result to function scope
- EntityDetails funcResultDetails;
- if (declTypeSpec_) {
- funcResultDetails.set_type(*declTypeSpec_);
- }
- const auto &resultName = funcResultName_ ? *funcResultName_ : funcName;
- MakeSymbol(resultName, funcResultDetails);
- if (resultName != funcName) {
- // add symbol for function to its scope; name can't be reused
- MakeSymbol(funcName, SubprogramDetails(dummyNames, funcResultName_));
- }
- endDeclTypeSpec();
- funcResultName_ = std::nullopt;
+ PostSubprogram(funcName, dummyNames);
+ // add function result to function scope
+ EntityDetails funcResultDetails;
+ if (declTypeSpec_) {
+ funcResultDetails.set_type(*declTypeSpec_);
}
+ const auto &resultName = funcResultName_ ? *funcResultName_ : funcName;
+ MakeSymbol(resultName, funcResultDetails);
+ if (resultName != funcName) {
+ // add symbol for function to its scope; name can't be reused
+ MakeSymbol(funcName, SubprogramDetails(dummyNames, funcResultName_));
+ }
+ endDeclTypeSpec();
+ funcResultName_ = std::nullopt;
+}
- void Post(const parser::Program &) {
- // ensure that all temps were deallocated
- CHECK(!attrs_);
- CHECK(!declTypeSpec_);
+void ResolveNamesVisitor::PostSubprogram(const Name &name, const std::list<Name> &dummyNames) {
+ const auto attrs = endAttrs();
+ MakeSymbol(name, attrs, SubprogramDetails(dummyNames));
+ Scope &subpScope = CurrScope().MakeScope(Scope::Kind::Subprogram);
+ PushScope(subpScope);
+ for (const auto &dummyName : dummyNames) {
+ MakeSymbol(dummyName, EntityDetails(true));
}
+}
+
+void ResolveNamesVisitor::Post(const parser::Program &) {
+ // ensure that all temps were deallocated
+ CHECK(!attrs_);
+ CHECK(!declTypeSpec_);
+}
-private:
- // Stack of containing scopes; memory referenced is owned by parent scopes
- std::stack<Scope *, std::list<Scope *>> scopes_;
- std::optional<Name> funcResultName_;
-};
void ResolveNames(const parser::Program &program) {
ResolveNamesVisitor visitor;
parser::Walk(program, visitor);
}
+
} // namespace Fortran::semantics
namespace Fortran {
namespace semantics {
-// Check that values specified for param defs are valid: they must match the
-// names of the params and any def that doesn't have a default value must have a
-// value.
-template<typename V>
-static void checkParams(
- std::string kindOrLen, TypeParamDefs defs, std::map<Name, V> values) {
- std::set<Name> validNames{};
- for (const TypeParamDef &def : defs) {
- Name name = def.name();
- validNames.insert(name);
- if (!def.defaultValue() && values.find(name) == values.end()) {
- parser::die("no value or default value for %s parameter '%s'",
- kindOrLen.c_str(), name.c_str());
- }
- }
- for (const auto &pair : values) {
- Name name = pair.first;
- if (validNames.find(name) == validNames.end()) {
- parser::die("invalid %s parameter '%s'", kindOrLen.c_str(), name.c_str());
- }
- }
-}
std::ostream &operator<<(std::ostream &o, const IntExpr &x) {
return x.Output(o);
}
+std::ostream &operator<<(std::ostream &o, const IntConst &x) {
+ return o << x.value_;
+}
std::unordered_map<std::uint64_t, IntConst> IntConst::cache;
return it->second;
}
-const LogicalTypeSpec *LogicalTypeSpec::Make() { return &helper.Make(); }
-const LogicalTypeSpec *LogicalTypeSpec::Make(KindParamValue kind) {
- return &helper.Make(kind);
+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);
+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);
+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);
+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 o << "END TYPE";
}
-DerivedTypeSpec::DerivedTypeSpec(DerivedTypeDef def,
- const KindParamValues &kindParamValues,
- const LenParamValues &lenParamValues)
- : def_{def}, kindParamValues_{kindParamValues}, lenParamValues_{
- 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();
- if (x.kindParamValues_.size() > 0 || x.lenParamValues_.size() > 0) {
+ o << "TYPE(" << x.name_;
+ if (!x.paramValues_.empty()) {
o << '(';
int n = 0;
- for (const auto &pair : x.kindParamValues_) {
+ for (const auto ¶mValue : x.paramValues_) {
if (n++) {
o << ", ";
}
- o << pair.first << '=' << pair.second;
- }
- for (const auto &pair : x.lenParamValues_) {
- if (n++) {
- o << ", ";
+ if (paramValue.first) {
+ o << *paramValue.first << '=';
}
- o << pair.first << '=' << pair.second;
+ o << paramValue.second;
}
o << ')';
}
}
}
+// All instances of IntrinsicTypeSpec live in caches and are never deleted,
+// so the pointer to intrinsicTypeSpec will always be valid
+// derivedTypeSpec_ is dynamically allocated and owned by the DeclTypeSpec
+DeclTypeSpec::DeclTypeSpec(Category category, const DerivedTypeSpec &derivedTypeSpec)
+ : category_{category}, intrinsicTypeSpec_{nullptr},
+ derivedTypeSpec_{new DerivedTypeSpec(derivedTypeSpec)} {
+ CHECK(category == TypeDerived || category == ClassDerived);
+}
+DeclTypeSpec::DeclTypeSpec(const DeclTypeSpec &that)
+ : category_{that.category_}, intrinsicTypeSpec_{that.intrinsicTypeSpec_} {
+ if (category_ == TypeDerived || category_ == ClassDerived) {
+ derivedTypeSpec_ = new DerivedTypeSpec(*that.derivedTypeSpec_);
+ }
+}
+DeclTypeSpec::~DeclTypeSpec() {
+ if (category_ == TypeDerived || category_ == ClassDerived) {
+ delete derivedTypeSpec_;
+ derivedTypeSpec_ = nullptr;
+ }
+}
+
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::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;
} // namespace semantics
} // namespace Fortran
-
-using namespace Fortran::semantics;
-
-void testTypeSpec() {
- 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";
- const CharacterTypeSpec c2{IntConst::Make(10)};
- std::cout << c2 << "\n";
-
- const IntegerTypeSpec *i1 = IntegerTypeSpec::Make();
- const IntegerTypeSpec *i2 = IntegerTypeSpec::Make(2);
- TypeParamDef lenParam{"my_len", *i2};
- TypeParamDef kindParam{"my_kind", *i1};
-
- DerivedTypeDef def1{DerivedTypeDefBuilder("my_name")
- .attrs({Attr::PRIVATE, Attr::BIND_C})
- .lenParam(lenParam)
- .kindParam(kindParam)
- .sequence()};
- // DerivedTypeDef def1{"my_name", {Attr::PRIVATE, Attr::BIND_C},
- // TypeParamDefs{lenParam}, TypeParamDefs{kindParam}, false, true};
-
- LenParamValues lenParamValues{
- LenParamValues::value_type{"my_len", LenParamValue::ASSUMED},
- };
- KindParamValues kindParamValues{
- KindParamValues::value_type{"my_kind", KindParamValue{123}},
- };
- // DerivedTypeSpec dt1{def1, kindParamValues, lenParamValues};
-
- // DerivedTypeSpec dt1{DerivedTypeSpec::Builder{"my_name2"}
- // .lenParamValue("my_len", LenParamValue::ASSUMED)
- // .attrs({Attr::BIND_C}).lenParam(lenParam)};
- // std::cout << dt1 << "\n";
-}
-
-void testShapeSpec() {
- const IntConst &ten{IntConst::Make(10)};
- const ShapeSpec s1{ShapeSpec::MakeExplicit(ten)};
- std::cout << "explicit-shape-spec: " << s1 << "\n";
- ShapeSpec s2{ShapeSpec::MakeExplicit(IntConst::Make(2), IntConst::Make(8))};
- std::cout << "explicit-shape-spec: " << s2 << "\n";
-
- ShapeSpec s3{ShapeSpec::MakeAssumed()};
- std::cout << "assumed-shape-spec: " << s3 << "\n";
- ShapeSpec s4{ShapeSpec::MakeAssumed(IntConst::Make(2))};
- std::cout << "assumed-shape-spec: " << s4 << "\n";
-
- ShapeSpec s5{ShapeSpec::MakeDeferred()};
- std::cout << "deferred-shape-spec: " << s5 << "\n";
-
- ShapeSpec s6{ShapeSpec::MakeImplied(IntConst::Make(2))};
- std::cout << "implied-shape-spec: " << s6 << "\n";
-
- ShapeSpec s7{ShapeSpec::MakeAssumedRank()};
- 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();
- //testProcComponentDef();
- //testDataComponentDef();
- return 0;
-}
-#endif
#define FORTRAN_TYPE_H_
#include "../parser/idioms.h"
+#include "../parser/parse-tree.h"
#include "attr.h"
#include <list>
#include <map>
// TODO
class IntExpr {
public:
- virtual const IntExpr *Clone() const { return new IntExpr{*this}; }
+ static IntExpr MakeConst(std::uint64_t value) {
+ return IntExpr(); // TODO
+ }
+ IntExpr() {}
+ IntExpr(const parser::ScalarIntExpr &) { /*TODO*/ }
virtual std::ostream &Output(std::ostream &o) const { return o << "IntExpr"; }
};
// TODO
-class IntConst : public IntExpr {
+class IntConst {
public:
static const IntConst &Make(std::uint64_t 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_; }
- std::ostream &Output(std::ostream &o) const override {
+ std::ostream &Output(std::ostream &o) const {
return o << this->value_;
}
static std::unordered_map<std::uint64_t, IntConst> cache;
IntConst(std::uint64_t value) : value_{value} {}
const std::uint64_t value_;
+ friend std::ostream &operator<<(std::ostream &, const IntConst &);
};
// The value of a kind type parameter
public:
static const Bound ASSUMED;
static const Bound DEFERRED;
- Bound(const IntExpr &expr) : category_{Explicit}, expr_{expr.Clone()} {}
+ Bound(const IntExpr &expr) : category_{Explicit}, expr_{expr} {}
bool isExplicit() const { return category_ == Explicit; }
bool isAssumed() const { return category_ == Assumed; }
bool isDeferred() const { return category_ == Deferred; }
- const IntExpr &getExplicit() const { return *expr_; }
+ const IntExpr &getExplicit() const {
+ CHECK(isExplicit());
+ return *expr_;
+ }
private:
enum Category { Explicit, Deferred, Assumed };
- Bound(Category category) : category_{category}, expr_{&IntConst::Make(0)} {}
+ Bound(Category category) : category_{category}, expr_{std::nullopt} {}
const Category category_;
- const IntExpr *const expr_;
+ const std::optional<IntExpr> expr_;
friend std::ostream &operator<<(std::ostream &, const Bound &);
};
class DeclTypeSpec {
public:
// intrinsic-type-spec or TYPE(intrinsic-type-spec)
- static DeclTypeSpec MakeIntrinsic(
- const IntrinsicTypeSpec *intrinsicTypeSpec) {
- return DeclTypeSpec{Intrinsic, intrinsicTypeSpec};
+ static DeclTypeSpec MakeIntrinsic(const IntrinsicTypeSpec &typeSpec) {
+ return DeclTypeSpec{typeSpec};
}
// TYPE(derived-type-spec)
- static DeclTypeSpec MakeTypeDerivedType(
- const DerivedTypeSpec *derivedTypeSpec) {
- return DeclTypeSpec{TypeDerived, nullptr, derivedTypeSpec};
+ static DeclTypeSpec MakeTypeDerivedType(const DerivedTypeSpec &typeSpec) {
+ return DeclTypeSpec{TypeDerived, typeSpec};
}
// CLASS(derived-type-spec)
- static DeclTypeSpec MakeClassDerivedType(
- const DerivedTypeSpec *derivedTypeSpec) {
- return DeclTypeSpec{ClassDerived, nullptr, derivedTypeSpec};
+ static DeclTypeSpec MakeClassDerivedType(const DerivedTypeSpec &typeSpec) {
+ return DeclTypeSpec{ClassDerived, typeSpec};
}
// TYPE(*)
static DeclTypeSpec MakeTypeStar() { return DeclTypeSpec{TypeStar}; }
// CLASS(*)
static DeclTypeSpec MakeClassStar() { return DeclTypeSpec{ClassStar}; }
+ DeclTypeSpec(const DeclTypeSpec &that);
+ ~DeclTypeSpec();
enum Category { Intrinsic, TypeDerived, ClassDerived, TypeStar, ClassStar };
Category category() const { return category_; }
- const IntrinsicTypeSpec *intrinsicTypeSpec() const {
- return intrinsicTypeSpec_;
+ const IntrinsicTypeSpec &intrinsicTypeSpec() const {
+ return *intrinsicTypeSpec_;
}
- const DerivedTypeSpec *derivedTypeSpec() const { return derivedTypeSpec_; }
+ const DerivedTypeSpec &derivedTypeSpec() const { return *derivedTypeSpec_; }
private:
- DeclTypeSpec(Category category,
- const IntrinsicTypeSpec *intrinsicTypeSpec = nullptr,
- const DerivedTypeSpec *derivedTypeSpec = nullptr)
- : category_{category}, intrinsicTypeSpec_{intrinsicTypeSpec},
- derivedTypeSpec_{derivedTypeSpec} {}
+ DeclTypeSpec(Category category) : category_{category} {
+ CHECK(category == TypeStar || category == ClassStar);
+ }
+ DeclTypeSpec(Category category, const DerivedTypeSpec &typeSpec);
+ DeclTypeSpec(const IntrinsicTypeSpec &intrinsicTypeSpec)
+ : category_{Intrinsic}, intrinsicTypeSpec_{&intrinsicTypeSpec} {}
+
Category category_;
- const IntrinsicTypeSpec *intrinsicTypeSpec_;
- const DerivedTypeSpec *derivedTypeSpec_;
+ const IntrinsicTypeSpec *intrinsicTypeSpec_{nullptr};
+ const DerivedTypeSpec *derivedTypeSpec_{nullptr};
friend std::ostream &operator<<(std::ostream &, const DeclTypeSpec &);
};
+
// Root of the *TypeSpec hierarchy
class TypeSpec {
public:
// One unique instance of LogicalTypeSpec for each kind.
class LogicalTypeSpec : public IntrinsicTypeSpec {
public:
- static const LogicalTypeSpec *Make();
- static const LogicalTypeSpec *Make(KindParamValue kind);
+ static const LogicalTypeSpec &Make();
+ static const LogicalTypeSpec &Make(KindParamValue kind);
std::ostream &Output(std::ostream &o) const override { return o << *this; }
private:
// One unique instance of IntegerTypeSpec for each kind.
class IntegerTypeSpec : public NumericTypeSpec {
public:
- static const IntegerTypeSpec *Make();
- static const IntegerTypeSpec *Make(KindParamValue kind);
+ static const IntegerTypeSpec &Make();
+ static const IntegerTypeSpec &Make(KindParamValue kind);
std::ostream &Output(std::ostream &o) const override { return o << *this; }
private:
// One unique instance of RealTypeSpec for each kind.
class RealTypeSpec : public NumericTypeSpec {
public:
- static const RealTypeSpec *Make();
- static const RealTypeSpec *Make(KindParamValue kind);
+ static const RealTypeSpec &Make();
+ static const RealTypeSpec &Make(KindParamValue kind);
std::ostream &Output(std::ostream &o) const override { return o << *this; }
private:
// One unique instance of ComplexTypeSpec for each kind.
class ComplexTypeSpec : public NumericTypeSpec {
public:
- static const ComplexTypeSpec *Make();
- static const ComplexTypeSpec *Make(KindParamValue kind);
+ static const ComplexTypeSpec &Make();
+ static const ComplexTypeSpec &Make(KindParamValue kind);
std::ostream &Output(std::ostream &o) const override { return o << *this; }
private:
}
// 1:ub
static const ShapeSpec MakeExplicit(const Bound &ub) {
- return MakeExplicit(IntConst::Make(1), ub);
+ return MakeExplicit(IntExpr::MakeConst(1), ub);
}
// 1: or lb:
- static ShapeSpec MakeAssumed(const Bound &lb = IntConst::Make(1)) {
+ static ShapeSpec MakeAssumed(const Bound &lb = IntExpr::MakeConst(1)) {
return ShapeSpec(lb, Bound::DEFERRED);
}
// :
return ShapeSpec(Bound::DEFERRED, Bound::DEFERRED);
}
// 1:* or lb:*
- static ShapeSpec MakeImplied(const Bound &lb = IntConst::Make(1)) {
+ static ShapeSpec MakeImplied(const Bound &lb = IntExpr::MakeConst(1)) {
return ShapeSpec(lb, Bound::ASSUMED);
}
// ..
friend class DerivedTypeDef;
};
-using KindParamValues = std::map<Name, KindParamValue>;
-using LenParamValues = std::map<Name, LenParamValue>;
+using ParamValue = LenParamValue;
// Instantiation of a DerivedTypeDef with kind and len parameter values
class DerivedTypeSpec : public TypeSpec {
public:
std::ostream &Output(std::ostream &o) const override { return o << *this; }
+ DerivedTypeSpec(const Name &name) : name_{name} {}
+ virtual ~DerivedTypeSpec() = default;
+ DerivedTypeSpec &AddParamValue(const ParamValue &value) {
+ paramValues_.push_back(std::make_pair(std::nullopt, value));
+ return *this;
+ }
+ DerivedTypeSpec &AddParamValue(const Name &name, const ParamValue &value) {
+ paramValues_.push_back(std::make_pair(name, value));
+ return *this;
+ }
private:
- const DerivedTypeDef def_;
- const KindParamValues kindParamValues_;
- const LenParamValues lenParamValues_;
- DerivedTypeSpec(DerivedTypeDef def, const KindParamValues &kindParamValues,
- const LenParamValues &lenParamValues);
+ const Name name_;
+ std::list<std::pair<std::optional<Name>, ParamValue>> paramValues_;
friend std::ostream &operator<<(std::ostream &, const DerivedTypeSpec &);
};
projects / platform / upstream / llvm.git / commitdiff