namespace Fortran::evaluate {
std::optional<DynamicType> GetSymbolType(const semantics::Symbol &symbol) {
- if (auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
- if (details->type().has_value()) {
- switch (details->type()->category()) {
- case semantics::DeclTypeSpec::Category::Intrinsic: {
- TypeCategory category{details->type()->intrinsicTypeSpec().category()};
- int kind{details->type()->intrinsicTypeSpec().kind()};
- if (IsValidKindOfIntrinsicType(category, kind)) {
- return std::make_optional(DynamicType{category, kind});
- }
- break;
- }
- case semantics::DeclTypeSpec::Category::TypeDerived:
- case semantics::DeclTypeSpec::Category::ClassDerived:
- return std::make_optional(DynamicType{
- TypeCategory::Derived, 0, &details->type()->derivedTypeSpec()});
- default:;
+ if (const auto *type{symbol.GetType()}) {
+ switch (type->category()) {
+ case semantics::DeclTypeSpec::Category::Intrinsic: {
+ TypeCategory category{type->intrinsicTypeSpec().category()};
+ int kind{type->intrinsicTypeSpec().kind()};
+ if (IsValidKindOfIntrinsicType(category, kind)) {
+ return DynamicType{category, kind};
}
+ break;
+ }
+ case semantics::DeclTypeSpec::Category::TypeDerived:
+ case semantics::DeclTypeSpec::Category::ClassDerived:
+ return DynamicType{TypeCategory::Derived, 0, &type->derivedTypeSpec()};
+ default:;
}
}
return std::nullopt;
n.ToString().data());
} else if (n.symbol->attrs().test(semantics::Attr::PARAMETER)) {
if (auto *details{n.symbol->detailsIf<semantics::ObjectEntityDetails>()}) {
- auto &init{details->init()};
- if (init.Resolve(context.context())) {
- return init.Get();
+ if (auto &init{details->init()}) {
+ return init;
}
}
context.Say(n.source, "parameter '%s' does not have a value"_err_en_US,
static void PutProcEntity(std::ostream &, const Symbol &);
static void PutTypeParam(std::ostream &, const Symbol &);
static void PutEntity(std::ostream &, const Symbol &, std::function<void()>);
-static void PutInit(std::ostream &, const LazyExpr &);
+static void PutInit(std::ostream &, const MaybeExpr &);
static void PutBound(std::ostream &, const Bound &);
-static void PutExpr(std::ostream &, const LazyExpr &);
+static void PutExpr(std::ostream &, const SomeExpr &);
static std::ostream &PutAttrs(
std::ostream &, Attrs, std::string before = ","s, std::string after = ""s);
static std::ostream &PutLower(std::ostream &, const Symbol &);
PutInit(os, details.init());
}
-void PutInit(std::ostream &os, const LazyExpr &init) {
- if (init.Get()) {
- PutExpr(os << '=', init);
+void PutInit(std::ostream &os, const MaybeExpr &init) {
+ if (init) {
+ PutExpr(os << '=', *init);
}
}
} else if (x.isDeferred()) {
os << ':';
} else {
- PutExpr(os, x.GetExplicit());
+ x.GetExplicit()->AsFortran(os);
}
}
-void PutExpr(std::ostream &os, const LazyExpr &expr) {
- if (auto x{expr.Get()}) {
- x->AsFortran(os);
- }
-}
+void PutExpr(std::ostream &os, const SomeExpr &expr) { expr.AsFortran(os); }
// Write an entity (object or procedure) declaration.
// writeType is called to write out the type.
#include "resolve-names.h"
#include "attr.h"
#include "default-kinds.h"
+#include "expression.h"
#include "mod-file.h"
#include "rewrite-parse-tree.h"
#include "scope.h"
#include "symbol.h"
#include "type.h"
#include "../common/indirection.h"
+#include "../evaluate/common.h"
+#include "../evaluate/fold.h"
+#include "../evaluate/tools.h"
#include "../parser/parse-tree-visitor.h"
#include "../parser/parse-tree.h"
#include <list>
class ResolveNamesVisitor;
static const parser::Name *GetGenericSpecName(const parser::GenericSpec &);
-static const parser::Expr &GetExpr(const parser::ConstantExpr &);
-static const parser::Expr &GetExpr(const parser::IntConstantExpr &);
-static const parser::Expr &GetExpr(const parser::IntExpr &);
-static const parser::Expr &GetExpr(const parser::ScalarIntExpr &);
-static const parser::Expr &GetExpr(const parser::ScalarIntConstantExpr &);
// ImplicitRules maps initial character of identifier to the DeclTypeSpec
// representing the implicit type; std::nullopt if none.
SemanticsContext &context() const { return *context_; }
void set_context(SemanticsContext &);
- template<typename... A>
- Message &Say(const parser::Name &name, MessageFixedText &&msg, A... args) {
- return Say(name.source, std::move(msg), std::forward<A>(args)...);
+ template<typename T> MaybeExpr EvaluateExpr(const T &expr) {
+ if (auto maybeExpr{AnalyzeExpr(*context_, expr)}) {
+ return evaluate::Fold(context_->foldingContext(), std::move(*maybeExpr));
+ } else {
+ return std::nullopt;
+ }
+ }
+
+ template<typename... A> Message &Say(const parser::Name &name, A... args) {
+ return messageHandler_.Say(name.source, std::forward<A>(args)...);
}
template<typename... A> Message &Say(A... args) {
return messageHandler_.Say(std::forward<A>(args)...);
explicit DeclTypeSpecVisitor() {}
using AttrsVisitor::Post;
using AttrsVisitor::Pre;
- 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::IntrinsicTypeSpec::DoublePrecision &);
- bool Pre(const parser::IntrinsicTypeSpec::DoubleComplex &);
+ void Post(const parser::IntegerTypeSpec &);
+ void Post(const parser::IntrinsicTypeSpec::Logical &);
+ void Post(const parser::IntrinsicTypeSpec::Real &);
+ void Post(const parser::IntrinsicTypeSpec::Complex &);
+ void Post(const parser::IntrinsicTypeSpec::DoublePrecision &);
+ void Post(const parser::IntrinsicTypeSpec::DoubleComplex &);
void Post(const parser::IntrinsicTypeSpec::Character &);
bool Pre(const parser::DeclarationTypeSpec::ClassStar &);
bool Pre(const parser::DeclarationTypeSpec::TypeStar &);
const parser::Name *derivedTypeName_{nullptr};
void SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec);
- void MakeIntrinsic(TypeCategory, int);
- static int GetKindParamValue(const std::optional<parser::KindSelector> &kind);
+ void MakeIntrinsic(TypeCategory, const std::optional<parser::KindSelector> &);
+ void MakeIntrinsic(TypeCategory, int kind);
+ int GetKindParamValue(
+ TypeCategory, const std::optional<parser::KindSelector> &);
ParamValue GetParamValue(const parser::TypeParamValue &);
};
bool Pre(const parser::ArraySpec &);
void Post(const parser::AttrSpec &) { PostAttrSpec(); }
void Post(const parser::ComponentAttrSpec &) { PostAttrSpec(); }
- bool Pre(const parser::DeferredShapeSpecList &);
- bool Pre(const parser::AssumedShapeSpec &);
- bool Pre(const parser::ExplicitShapeSpec &);
- bool Pre(const parser::AssumedImpliedSpec &);
- bool Pre(const parser::AssumedRankSpec &);
+ void Post(const parser::DeferredShapeSpecList &);
+ void Post(const parser::AssumedShapeSpec &);
+ void Post(const parser::ExplicitShapeSpec &);
+ void Post(const parser::AssumedImpliedSpec &);
+ void Post(const parser::AssumedRankSpec &);
protected:
const ArraySpec &arraySpec();
bool Pre(const parser::BindStmt &) { return BeginAttrs(); }
void Post(const parser::BindStmt &) { EndAttrs(); }
bool Pre(const parser::BindEntity &);
- bool Pre(const parser::NamedConstantDef &);
+ void Post(const parser::NamedConstantDef &);
bool Pre(const parser::AsynchronousStmt &);
bool Pre(const parser::ContiguousStmt &);
bool Pre(const parser::ExternalStmt &);
ParamValue DeclTypeSpecVisitor::GetParamValue(const parser::TypeParamValue &x) {
return std::visit(
common::visitors{
- [](const parser::ScalarIntExpr &x) { return ParamValue{GetExpr(x)}; },
+ [=](const parser::ScalarIntExpr &x) {
+ return ParamValue{EvaluateExpr(x)};
+ },
[](const parser::Star &) { return ParamValue::Assumed(); },
[](const parser::TypeParamValue::Deferred &) {
return ParamValue::Deferred();
derivedTypeName_ = nullptr;
}
-bool DeclTypeSpecVisitor::Pre(const parser::IntegerTypeSpec &x) {
- MakeIntrinsic(TypeCategory::Integer, GetKindParamValue(x.v));
- return false;
+void DeclTypeSpecVisitor::Post(const parser::IntegerTypeSpec &x) {
+ MakeIntrinsic(TypeCategory::Integer, x.v);
}
void DeclTypeSpecVisitor::Post(const parser::IntrinsicTypeSpec::Character &x) {
CHECK(!"TODO: character");
}
-bool DeclTypeSpecVisitor::Pre(const parser::IntrinsicTypeSpec::Logical &x) {
- MakeIntrinsic(TypeCategory::Logical, GetKindParamValue(x.kind));
- return false;
+void DeclTypeSpecVisitor::Post(const parser::IntrinsicTypeSpec::Logical &x) {
+ MakeIntrinsic(TypeCategory::Logical, x.kind);
}
-bool DeclTypeSpecVisitor::Pre(const parser::IntrinsicTypeSpec::Real &x) {
- MakeIntrinsic(TypeCategory::Real, GetKindParamValue(x.kind));
- return false;
+void DeclTypeSpecVisitor::Post(const parser::IntrinsicTypeSpec::Real &x) {
+ MakeIntrinsic(TypeCategory::Real, x.kind);
}
-bool DeclTypeSpecVisitor::Pre(const parser::IntrinsicTypeSpec::Complex &x) {
- MakeIntrinsic(TypeCategory::Complex, GetKindParamValue(x.kind));
- return false;
+void DeclTypeSpecVisitor::Post(const parser::IntrinsicTypeSpec::Complex &x) {
+ MakeIntrinsic(TypeCategory::Complex, x.kind);
}
-bool DeclTypeSpecVisitor::Pre(
+void DeclTypeSpecVisitor::Post(
const parser::IntrinsicTypeSpec::DoublePrecision &) {
MakeIntrinsic(
TypeCategory::Real, context().defaultKinds().doublePrecisionKind());
- return false;
}
-bool DeclTypeSpecVisitor::Pre(
+void DeclTypeSpecVisitor::Post(
const parser::IntrinsicTypeSpec::DoubleComplex &) {
MakeIntrinsic(
TypeCategory::Complex, context().defaultKinds().doublePrecisionKind());
- return false;
+}
+void DeclTypeSpecVisitor::MakeIntrinsic(
+ TypeCategory category, const std::optional<parser::KindSelector> &kind) {
+ MakeIntrinsic(category, GetKindParamValue(category, kind));
}
void DeclTypeSpecVisitor::MakeIntrinsic(TypeCategory category, int kind) {
if (kind == 0) {
}
int DeclTypeSpecVisitor::GetKindParamValue(
- const std::optional<parser::KindSelector> &kind) {
- if (kind) {
- if (auto *intExpr{std::get_if<parser::ScalarIntConstantExpr>(&kind->u)}) {
- const auto &expr{GetExpr(*intExpr)};
- if (auto *lit{std::get_if<parser::LiteralConstant>(&expr.u)}) {
- if (auto *intLit{std::get_if<parser::IntLiteralConstant>(&lit->u)}) {
- return std::get<std::uint64_t>(intLit->t);
- }
- }
- CHECK(!"TODO: constant evaluation");
- } else {
- CHECK(!"TODO: translate star-size to kind");
- }
+ TypeCategory category, const std::optional<parser::KindSelector> &kind) {
+ if (!kind) {
+ return 0;
}
- return 0;
+ // TODO: check that we get a valid kind
+ return std::visit(
+ common::visitors{
+ [&](const parser::ScalarIntConstantExpr &x) -> int {
+ if (auto maybeExpr{EvaluateExpr(x)}) {
+ return evaluate::ToInt64(*maybeExpr).value();
+ } else {
+ return 0;
+ }
+ },
+ [&](const parser::KindSelector::StarSize &x) -> int {
+ std::uint64_t size{x.v};
+ if (category == TypeCategory::Complex) {
+ size /= 2;
+ }
+ return size;
+ },
+ },
+ kind->u);
}
// MessageHandler implementation
return true;
}
-bool ArraySpecVisitor::Pre(const parser::DeferredShapeSpecList &x) {
+void ArraySpecVisitor::Post(const parser::DeferredShapeSpecList &x) {
for (int i = 0; i < x.v; ++i) {
arraySpec_.push_back(ShapeSpec::MakeDeferred());
}
- return false;
}
-bool ArraySpecVisitor::Pre(const parser::AssumedShapeSpec &x) {
+void ArraySpecVisitor::Post(const parser::AssumedShapeSpec &x) {
const auto &lb{x.v};
arraySpec_.push_back(
lb ? ShapeSpec::MakeAssumed(GetBound(*lb)) : ShapeSpec::MakeAssumed());
- return true;
}
-bool ArraySpecVisitor::Pre(const parser::ExplicitShapeSpec &x) {
+void ArraySpecVisitor::Post(const parser::ExplicitShapeSpec &x) {
auto &&ub{GetBound(std::get<parser::SpecificationExpr>(x.t))};
if (const auto &lb{std::get<std::optional<parser::SpecificationExpr>>(x.t)}) {
arraySpec_.push_back(ShapeSpec::MakeExplicit(GetBound(*lb), std::move(ub)));
} else {
arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}, std::move(ub)));
}
- return true;
}
-bool ArraySpecVisitor::Pre(const parser::AssumedImpliedSpec &x) {
+void ArraySpecVisitor::Post(const parser::AssumedImpliedSpec &x) {
const auto &lb{x.v};
arraySpec_.push_back(
lb ? ShapeSpec::MakeImplied(GetBound(*lb)) : ShapeSpec::MakeImplied());
- return false;
}
-bool ArraySpecVisitor::Pre(const parser::AssumedRankSpec &) {
+void ArraySpecVisitor::Post(const parser::AssumedRankSpec &) {
arraySpec_.push_back(ShapeSpec::MakeAssumedRank());
- return false;
}
const ArraySpec &ArraySpecVisitor::arraySpec() {
}
Bound ArraySpecVisitor::GetBound(const parser::SpecificationExpr &x) {
- return Bound{GetExpr(x.v)};
+ return Bound{EvaluateExpr(x.v)};
}
// ScopeHandler implementation
const Symbol &ultimate{genericSymbol->GetUltimate()};
EraseSymbol(*genericName_);
genericSymbol = &CopySymbol(ultimate);
+ genericName_->symbol = genericSymbol;
if (const auto *details{ultimate.detailsIf<GenericDetails>()}) {
genericSymbol->set_details(GenericDetails{details->specificProcs()});
} else if (const auto *details{ultimate.detailsIf<SubprogramDetails>()}) {
// okay
} else if (genericSymbol->has<SubprogramDetails>() ||
genericSymbol->has<SubprogramNameDetails>()) {
- Details details;
- if (auto *d{genericSymbol->detailsIf<SubprogramNameDetails>()}) {
- details = *d;
- } else if (auto *d{genericSymbol->detailsIf<SubprogramDetails>()}) {
- details = *d;
- } else {
- common::die("unexpected kind of symbol");
- }
GenericDetails genericDetails;
genericDetails.set_specific(*genericSymbol);
EraseSymbol(*genericName_);
genericSymbol = &MakeSymbol(*genericName_, genericDetails);
+ } else {
+ common::die("unexpected kind of symbol");
}
- CHECK(genericSymbol->has<GenericDetails>());
CHECK(genericName_->symbol == genericSymbol);
return false;
}
GenericDetails &InterfaceVisitor::GetGenericDetails() {
CHECK(genericName_);
+ CHECK(genericName_->symbol);
return genericName_->symbol->get<GenericDetails>();
}
Symbol &symbol{DeclareUnknownEntity(name, attrs)};
if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
if (ConvertToObjectEntity(symbol)) {
- if (auto *
initExpr{std::get_if<parser::ConstantExpr>(&init->u)}) {
- symbol.get<ObjectEntityDetails>().set_init(GetExpr(*initExpr));
+ if (auto *
expr{std::get_if<parser::ConstantExpr>(&init->u)}) {
+ symbol.get<ObjectEntityDetails>().set_init(EvaluateExpr(*expr));
}
}
}
}
return false;
}
-bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) {
+void DeclarationVisitor::Post(const parser::NamedConstantDef &x) {
auto &name{std::get<parser::NamedConstant>(x.t).v};
auto &symbol{HandleAttributeStmt(Attr::PARAMETER, name)};
if (!ConvertToObjectEntity(symbol)) {
Say2(name, "PARAMETER attribute not allowed on '%s'"_err_en_US, symbol,
"Declaration of '%s'"_en_US);
- return false;
+ return;
}
const auto &expr{std::get<parser::ConstantExpr>(x.t)};
- symbol.get<ObjectEntityDetails>().set_init(GetExpr(expr));
+ symbol.get<ObjectEntityDetails>().set_init(EvaluateExpr(expr));
ApplyImplicitRules(symbol);
- return false;
}
bool DeclarationVisitor::Pre(const parser::AsynchronousStmt &x) {
return HandleAttributeStmt(Attr::ASYNCHRONOUS, x.v);
auto details{TypeParamDetails{attr}};
if (auto &init{
std::get<std::optional<parser::ScalarIntConstantExpr>>(decl.t)}) {
- details.set_init(GetExpr(*init));
+ details.set_init(EvaluateExpr(*init));
}
MakeTypeSymbol(name, std::move(details));
SetType(name, *type);
if (auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
if (auto *initExpr{std::get_if<parser::ConstantExpr>(&init->u)}) {
- details->set_init(GetExpr(*initExpr));
+ details->set_init(EvaluateExpr(*initExpr));
}
}
}
std::get<parser::LoopBounds<parser::ScalarIntConstantExpr>>(x.t)};
if (type) {
BeginDeclTypeSpec();
- DeclTypeSpecVisitor::Pre(*type);
+ DeclTypeSpecVisitor::Post(*type);
}
if (auto *symbol{DeclareConstructEntity(bounds.name.thing.thing)}) {
CheckIntegerType(*symbol);
// OK
} else if (symbol->has<DerivedTypeDetails>()) {
// OK: type constructor
- } else if (auto *details{symbol->detailsIf<ObjectEntityDetails>()};
- details && details->isArray()) {
+ } else if (symbol->has<ObjectEntityDetails>()) {
// OK: array mis-parsed as a call
} else if (symbol->test(Symbol::Flag::Implicit)) {
Say(*name,
return nullptr;
}
}
-
-static const parser::Expr &GetExpr(const parser::ConstantExpr &x) {
- return *x.thing;
-}
-static const parser::Expr &GetExpr(const parser::IntExpr &x) {
- return *x.thing;
-}
-static const parser::Expr &GetExpr(const parser::IntConstantExpr &x) {
- return GetExpr(x.thing);
-}
-static const parser::Expr &GetExpr(const parser::ScalarIntExpr &x) {
- return GetExpr(x.thing);
-}
-static const parser::Expr &GetExpr(const parser::ScalarIntConstantExpr &x) {
- return GetExpr(x.thing);
-}
}
if (AnyFatalError()) {
return false;
}
- ResolveSymbolExprs(context_);
if (AnyFatalError()) {
return false;
}
}
}
-void TypeParamDetails::set_init(const parser::Expr &expr) {
- init_ = LazyExpr{expr};
-}
-
const Symbol &UseDetails::module() const {
// owner is a module so it must have a symbol:
return *symbol_->owner().symbol();
ObjectEntityDetails::ObjectEntityDetails(const EntityDetails &d)
: isDummy_{d.isDummy()}, type_{d.type()} {}
-void ObjectEntityDetails::set_init(const parser::Expr &x) {
- init_ = LazyExpr{x};
-}
-
std::ostream &operator<<(std::ostream &os, const EntityDetails &x) {
if (x.type()) {
os << " type: " << *x.type();
os << ' ' << s;
}
}
- if (x.init_.Get()) {
- os << " init:" << x.init_;
+ if (x.init_) {
+ x.init_->AsFortran(os << " init:");
}
return os;
}
os << ' ' << *x.type();
}
os << ' ' << common::EnumToString(x.attr());
- if (x.init().Get()) {
- os << " init:" << x.init();
+ if (x.init()) {
+ x.init()->AsFortran(os << " init:");
}
},
[&](const MiscDetails &x) {
public:
ObjectEntityDetails(const EntityDetails &);
ObjectEntityDetails(bool isDummy = false) : isDummy_{isDummy} {}
- LazyExpr &init() { return init_; }
- const LazyExpr &init() const { return init_; }
- void set_init(const parser::Expr &);
+ MaybeExpr &init() { return init_; }
+ const MaybeExpr &init() const { return init_; }
+ void set_init(MaybeExpr &&expr) { init_ = std::move(expr); }
const std::optional<DeclTypeSpec> &type() const { return type_; }
void set_type(const DeclTypeSpec &type);
ArraySpec &shape() { return shape_; }
private:
bool isDummy_;
- LazyExpr init_;
+ MaybeExpr init_;
std::optional<DeclTypeSpec> type_;
ArraySpec shape_;
friend std::ostream &operator<<(std::ostream &, const ObjectEntityDetails &);
public:
TypeParamDetails(common::TypeParamAttr attr) : attr_{attr} {}
common::TypeParamAttr attr() const { return attr_; }
- // std::optional<LazyExpr> &init() { return init_; }
- // const std::optional<LazyExpr> &init() const { return init_; }
- LazyExpr &init() { return init_; }
- const LazyExpr &init() const { return init_; }
- void set_init(const parser::Expr &);
+ MaybeExpr &init() { return init_; }
+ const MaybeExpr &init() const { return init_; }
+ void set_init(MaybeExpr &&expr) { init_ = std::move(expr); }
const std::optional<DeclTypeSpec> &type() const { return type_; }
void set_type(const DeclTypeSpec &type) {
CHECK(!type_);
private:
common::TypeParamAttr attr_;
- LazyExpr init_;
+ MaybeExpr init_;
std::optional<DeclTypeSpec> type_;
};
namespace Fortran::semantics {
-LazyExpr::LazyExpr(SomeExpr &&expr) : u_{CopyableExprPtr{std::move(expr)}} {}
-
-MaybeExpr LazyExpr::Get() { return static_cast<const LazyExpr *>(this)->Get(); }
-
-const MaybeExpr LazyExpr::Get() const {
- if (auto *ptr{std::get_if<CopyableExprPtr>(&u_)}) {
- return **ptr;
- } else {
- return std::nullopt;
- }
-}
-
-bool LazyExpr::Resolve(SemanticsContext &context) {
- if (auto *expr{std::get_if<const parser::Expr *>(&u_)}) {
- if (!*expr) {
- u_ = ErrorInExpr{};
- } else if (MaybeExpr maybeExpr{AnalyzeExpr(context, **expr)}) {
- u_ = CopyableExprPtr{
- evaluate::Fold(context.foldingContext(), std::move(*maybeExpr))};
- } else {
- u_ = ErrorInExpr{};
- }
- }
- return std::holds_alternative<CopyableExprPtr>(u_);
-}
-
-std::ostream &operator<<(std::ostream &o, const LazyExpr &x) {
- std::visit(
- common::visitors{
- [&](const parser::Expr *x) { o << (x ? "UNRESOLVED" : "EMPTY"); },
- [&](const LazyExpr::ErrorInExpr &) { o << "ERROR"; },
- [&](const LazyExpr::CopyableExprPtr &x) { x->AsFortran(o); },
- },
- x.u_);
- return o;
-}
-
void DerivedTypeSpec::set_scope(const Scope &scope) {
CHECK(!scope_);
CHECK(scope.kind() == Scope::Kind::DerivedType);
expr_{SomeExpr{evaluate::AsExpr(
evaluate::Constant<evaluate::SubscriptInteger>{bound})}} {}
-void Bound::Resolve(SemanticsContext &context) {
- if (isExplicit()) {
- expr_.Resolve(context);
- }
-}
+Bound Bound::Clone() const { return Bound(category_, MaybeExpr{expr_}); }
std::ostream &operator<<(std::ostream &o, const Bound &x) {
if (x.isAssumed()) {
o << '*';
} else if (x.isDeferred()) {
o << ':';
+ } else if (x.expr_) {
+ x.expr_->AsFortran(o);
} else {
- o << x.expr_;
+ o << "<no-expr>";
}
return o;
}
return o;
}
-ParamValue::ParamValue(const parser::Expr &expr)
- : category_{Category::Explicit}, expr_{expr} {}
-
-void ParamValue::ResolveExplicit(SemanticsContext &context) {
- CHECK(isExplicit());
- expr_.Resolve(context);
-}
-
std::ostream &operator<<(std::ostream &o, const ParamValue &x) {
if (x.isAssumed()) {
o << '*';
} else if (x.isDeferred()) {
o << ':';
+ } else if (!x.GetExplicit()) {
+ o << "<no-expr>";
} else {
- o << x.GetExplicit();
+ x.GetExplicit()->AsFortran(o);
}
return o;
}
CHECK(!symbol_);
type_ = type;
}
-
-class ExprResolver {
-public:
- ExprResolver(SemanticsContext &context) : context_{context} {}
- void Resolve() { Resolve(context_.globalScope()); }
-
-private:
- SemanticsContext &context_;
-
- void Resolve(Scope &);
- void Resolve(Symbol &);
- void Resolve(Bound &bound) { bound.Resolve(context_); }
- void Resolve(LazyExpr &expr) { expr.Resolve(context_); }
-};
-
-void ExprResolver::Resolve(Scope &scope) {
- for (auto &pair : scope) {
- Resolve(*pair.second);
- }
- for (auto &child : scope.children()) {
- Resolve(child);
- }
-}
-void ExprResolver::Resolve(Symbol &symbol) {
- if (auto *type{symbol.GetType()}) {
- if (type->category() == DeclTypeSpec::TypeDerived) {
- DerivedTypeSpec &dts{type->derivedTypeSpec()};
- for (auto &nameAndValue : dts.paramValues()) {
- // &[name, value] elicits "unused variable" warnings
- auto &value{nameAndValue.second};
- if (value.isExplicit()) {
- value.ResolveExplicit(context_);
- }
- }
- }
- }
- if (auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
- Resolve(details->init());
- for (ShapeSpec &shapeSpec : details->shape()) {
- Resolve(shapeSpec.lb_);
- Resolve(shapeSpec.ub_);
- }
- } else if (auto *details{symbol.detailsIf<TypeParamDetails>()}) {
- Resolve(details->init());
- }
-}
-
-void ResolveSymbolExprs(SemanticsContext &context) {
- ExprResolver(context).Resolve();
-}
}
using SomeExpr = evaluate::Expr<evaluate::SomeType>;
using MaybeExpr = std::optional<SomeExpr>;
-// An expression that starts out as a parser::Expr and gets resolved to
-// a MaybeExpr. Resolve should not be called until after names are resolved.
-// An unresolved LazyExpr should not be used after the parse tree is deleted.
-class LazyExpr {
-public:
- LazyExpr() : u_{nullptr} {}
- LazyExpr(const parser::Expr &expr) : u_{&expr} {}
- LazyExpr(SomeExpr &&);
- LazyExpr(LazyExpr &&) = default;
- LazyExpr &operator=(LazyExpr &&) = default;
- LazyExpr Clone() const { return LazyExpr(*this); }
- const MaybeExpr Get() const;
- MaybeExpr Get();
- bool Resolve(SemanticsContext &);
-
-private:
- using CopyableExprPtr = common::Indirection<SomeExpr, true>;
- struct ErrorInExpr {}; // marks an expr with an error in evaluation
- std::variant<const parser::Expr *, CopyableExprPtr, ErrorInExpr> u_;
-
- LazyExpr(const LazyExpr &) = default;
- friend std::ostream &operator<<(std::ostream &, const LazyExpr &);
-};
-
// An array spec bound: an explicit integer expression or ASSUMED or DEFERRED
class Bound {
public:
static Bound Assumed() { return Bound(Category::Assumed); }
static Bound Deferred() { return Bound(Category::Deferred); }
- Bound(const parser::Expr &expr)
- : category_{Category::Explicit}, expr_{expr} {}
+ Bound(MaybeExpr &&expr)
+ : category_{Category::Explicit}, expr_{std::move(expr)} {}
Bound(int bound);
Bound(Bound &&) = default;
Bound &operator=(Bound &&) = default;
- Bound Clone() const { return Bound(category_, expr_.Clone()); }
+ Bound Clone() const;
bool isExplicit() const { return category_ == Category::Explicit; }
bool isAssumed() const { return category_ == Category::Assumed; }
bool isDeferred() const { return category_ == Category::Deferred; }
- const LazyExpr &GetExplicit() const { return expr_; }
- void Resolve(SemanticsContext &);
+ const MaybeExpr &GetExplicit() const { return expr_; }
private:
enum class Category { Explicit, Deferred, Assumed };
Bound(Category category) : category_{category} {}
- Bound(Category category, LazyExpr &&expr)
+ Bound(Category category, MaybeExpr &&expr)
: category_{category}, expr_{std::move(expr)} {}
Category category_;
- LazyExpr expr_;
+ MaybeExpr expr_;
friend std::ostream &operator<<(std::ostream &, const Bound &);
};
public:
static const ParamValue Assumed() { return Category::Assumed; }
static const ParamValue Deferred() { return Category::Deferred; }
- ParamValue(const parser::Expr &);
+ ParamValue(MaybeExpr &&expr)
+ : category_{Category::Explicit}, expr_{std::move(expr)} {}
bool isExplicit() const { return category_ == Category::Explicit; }
bool isAssumed() const { return category_ == Category::Assumed; }
bool isDeferred() const { return category_ == Category::Deferred; }
- const LazyExpr &GetExplicit() const { return expr_; }
- void ResolveExplicit(SemanticsContext &);
+ const MaybeExpr &GetExplicit() const { return expr_; }
private:
enum class Category { Explicit, Deferred, Assumed };
ParamValue(Category category) : category_{category} {}
Category category_;
- LazyExpr expr_;
+ MaybeExpr expr_;
friend std::ostream &operator<<(std::ostream &, const ParamValue &);
};
const Symbol *symbol_{nullptr};
std::optional<DeclTypeSpec> type_;
};
-
-// Resolve expressions in symbols.
-void ResolveSymbolExprs(SemanticsContext &);
}
#endif // FORTRAN_SEMANTICS_TYPE_H_
resolve34.f90
resolve35.f90
resolve36.f90
+ resolve37.f90
)
# These test files have expected symbols in the source
subroutine sub00(a,b,n,m)
+ integer :: n, m
real a(n)
real :: b(m)
1 print *, n, m
end subroutine sub00
subroutine do_loop01(a,n)
+ integer :: n
real, dimension(n) :: a
do 10 i = 1, n
print *, i, a(i)
end subroutine do_loop01
subroutine do_loop02(a,n)
+ integer :: n
real, dimension(n,n) :: a
do 10 j = 1, n
do 10 i = 1, n
#ifndef STRICT_F18
subroutine do_loop03(a,n)
+ integer :: n
real, dimension(n) :: a
do 10 i = 1, n
10 print *, i, a(i) ! extension (not f18)
end subroutine do_loop03
subroutine do_loop04(a,n)
+ integer :: n
real :: a(n,n)
do 10 j = 1, n
do 10 i = 1, n
end subroutine do_loop04
subroutine do_loop05(a,n)
+ integer :: n
real a(n,n,n)
do 10 k = 1, n
do 10 j = 1, n
#endif
subroutine do_loop06(a,n)
+ integer :: n
real, dimension(n) :: a
loopname: do i = 1, n
print *, i, a(i)
end subroutine do_loop06
subroutine do_loop07(a,n)
+ integer :: n
real, dimension(n,n) :: a
loopone: do j = 1, n
looptwo: do i = 1, n
end subroutine do_loop07
subroutine do_loop08(a,b,n,m,nn)
+ integer :: n, m, nn
real, dimension(n,n) :: a
real b(m,nn)
loopone: do j = 1, n
#ifndef STRICT_F18
! extended ranges supported by PGI, gfortran gives warnings
subroutine do_loop09(a,n,j)
+ integer :: n
real a(n)
goto 400
200 print *, "found the index", j
module m
integer(8), parameter :: a = 1, b = 2_8
- parameter(n=3)
+ parameter(n=3,l=-3,e=1.0/3.0)
real :: x(a:2*(a+b*n)-1)
real, dimension(8) :: y
type t(c, d)
integer, kind :: c = 1
integer, len :: d = a + b
end type
- type(t(3,:)), allocatable :: z
+ type(t(a+3,:)), allocatable :: z
+ real*2 :: f
+ complex*32 :: g
contains
subroutine foo(x)
real :: x(2:)
! integer(8),parameter::a=1_4
! integer(8),parameter::b=2_8
! integer(4),parameter::n=3_4
+! integer(4),parameter::l=-3_4
+! real(4),parameter::e=3.333333432674407958984375e-1_4
! real(4)::x(1_4:13_8)
! real(4)::y(1_8:8_4)
! type::t(c,d)
! integer(4),kind::c=1_4
! integer(4),len::d=3_8
! end type
-! type(t(3_4,:)),allocatable::z
+! type(t(4_4,:)),allocatable::z
+! real(2)::f
+! complex(16)::g
!contains
! subroutine foo(x)
! real(4)::x(2_4:)
--- /dev/null
+! Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+! http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+integer, parameter :: k = 8
+real, parameter :: l = 8.0
+integer :: n = 2
+!ERROR: expression must be constant
+parameter(m=n)
+integer(k) :: x
+!ERROR: expression must be INTEGER
+integer(l) :: y
+!ERROR: expression must be constant
+integer(n) :: z
+type t(k)
+ integer, kind :: k
+end type
+!ERROR: expression must be INTEGER
+type(t(.true.)) :: w
+!ERROR: expression must be INTEGER
+real :: w(l*2)
+end
projects / platform / upstream / llvm.git / commitdiff