#include "../common/idioms.h"
#include "../evaluate/common.h"
#include "../evaluate/fold.h"
-#include "../evaluate/intrinsics.h"
#include "../evaluate/tools.h"
#include "../parser/parse-tree-visitor.h"
#include "../parser/parse-tree.h"
"TODO INTERNAL: name '%s' was not resolved to a symbol"_err_en_US,
n.ToString().data());
} else if (n.symbol->attrs().test(semantics::Attr::PARAMETER)) {
- Say("TODO: PARAMETER references not yet implemented"_err_en_US);
+ if (auto *details{n.symbol->detailsIf<semantics::ObjectEntityDetails>()}) {
+ auto &init{details->init()};
+ if (init.Resolve(context)) {
+ return init.Get();
+ }
+ }
+ Say(n.source, "parameter '%s' does not have a value"_err_en_US,
+ n.ToString().data());
// TODO: enumerators, do they have the PARAMETER attribute?
} else {
if (MaybeExpr result{Designate(DataRef{*n.symbol})}) {
}
MaybeExpr ExprAnalyzer::Analyze(const parser::ArrayConstructor &) {
- Say("TODO: ArrayConstructor unimplemented"_err_en_US);
+ Say("TODO: ArrayConstructor unimplemented"_en_US);
return std::nullopt;
}
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 PutBound(std::ostream &, const Bound &);
+static void PutExpr(std::ostream &, const LazyExpr &);
static std::ostream &PutAttrs(
std::ostream &, Attrs, std::string before = ","s, std::string after = ""s);
static std::ostream &PutLower(std::ostream &, const Symbol &);
},
},
symbol.details());
+ os << '\n';
+}
+
+void PutShapeSpec(std::ostream &os, const ShapeSpec &x) {
+ if (x.ubound().isAssumed()) {
+ CHECK(x.ubound().isAssumed());
+ os << "..";
+ } else {
+ if (!x.lbound().isDeferred()) {
+ PutBound(os, x.lbound());
+ }
+ os << ':';
+ if (!x.ubound().isDeferred()) {
+ PutBound(os, x.ubound());
+ }
+ }
+}
+void PutShape(std::ostream &os, const ArraySpec &shape) {
+ if (!shape.empty()) {
+ os << '(';
+ bool first{true};
+ for (const auto &shapeSpec : shape) {
+ if (first) {
+ first = false;
+ } else {
+ os << ',';
+ }
+ PutShapeSpec(os, shapeSpec);
+ }
+ os << ')';
+ }
}
void PutObjectEntity(std::ostream &os, const Symbol &symbol) {
CHECK(type);
PutLower(os, *type);
});
+ PutShape(os, symbol.get<ObjectEntityDetails>().shape());
+ PutInit(os, symbol.get<ObjectEntityDetails>().init());
}
void PutProcEntity(std::ostream &os, const Symbol &symbol) {
}
void PutTypeParam(std::ostream &os, const Symbol &symbol) {
+ auto &details{symbol.get<TypeParamDetails>()};
PutEntity(os, symbol, [&]() {
auto *type{symbol.GetType()};
CHECK(type);
PutLower(os, *type);
- PutLower(
- os << ',', common::EnumToString(symbol.get<TypeParamDetails>().attr()));
+ PutLower(os << ',', common::EnumToString(details.attr()));
});
+ PutInit(os, details.init());
+}
+
+void PutInit(std::ostream &os, const LazyExpr &init) {
+ if (init.Get()) {
+ PutExpr(os << '=', init);
+ }
+}
+
+void PutBound(std::ostream &os, const Bound &x) {
+ if (x.isAssumed()) {
+ os << '*';
+ } else if (x.isDeferred()) {
+ os << ':';
+ } else {
+ PutExpr(os, x.GetExplicit());
+ }
+}
+
+void PutExpr(std::ostream &os, const LazyExpr &expr) {
+ if (expr.Get()) {
+ // TODO: Dump does not necessarily produce Fortran code
+ expr.Get()->Dump(os);
+ }
}
// Write an entity (object or procedure) declaration.
std::ostream &os, const Symbol &symbol, std::function<void()> writeType) {
writeType();
PutAttrs(os, symbol.attrs());
- PutLower(os << "::", symbol) << '\n';
+ PutLower(os << "::", symbol);
}
// Put out each attribute to os, surrounded by `before` and `after` and
class ResolveNamesVisitor;
static GenericSpec MapGenericSpec(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.
bool Pre(const parser::DeclarationTypeSpec::TypeStar &);
bool Pre(const parser::DeclarationTypeSpec::Record &);
void Post(const parser::TypeParamSpec &);
- void Post(const parser::TypeParamValue &);
bool Pre(const parser::TypeGuardStmt &);
void Post(const parser::TypeGuardStmt &);
bool expectDeclTypeSpec_{false}; // should only see decl-type-spec when true
std::unique_ptr<DeclTypeSpec> declTypeSpec_;
DerivedTypeSpec *derivedTypeSpec_{nullptr};
- std::unique_ptr<ParamValue> typeParamValue_;
SemanticsContext *context_{nullptr};
void MakeIntrinsic(TypeCategory, int);
void SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec);
static int GetKindParamValue(const std::optional<parser::KindSelector> &kind);
+ ParamValue GetParamValue(const parser::TypeParamValue &);
};
// Track statement source locations and save messages.
SetDeclTypeSpec(DeclTypeSpec{DeclTypeSpec::TypeStar});
return false;
}
+
void DeclTypeSpecVisitor::Post(const parser::TypeParamSpec &x) {
- typeParamValue_.reset();
+ const auto &value{std::get<parser::TypeParamValue>(x.t)};
+ if (const auto &keyword{std::get<std::optional<parser::Keyword>>(x.t)}) {
+ derivedTypeSpec_->AddParamValue(keyword->v.source, GetParamValue(value));
+ } else {
+ derivedTypeSpec_->AddParamValue(GetParamValue(value));
+ }
}
-void DeclTypeSpecVisitor::Post(const parser::TypeParamValue &x) {
- typeParamValue_ = std::make_unique<ParamValue>(std::visit(
+
+ParamValue DeclTypeSpecVisitor::GetParamValue(const parser::TypeParamValue &x) {
+ return std::visit(
common::visitors{
- // TODO: create IntExpr from ScalarIntExpr
- [&](const parser::ScalarIntExpr &x) { return Bound{IntExpr{}}; },
- [&](const parser::Star &x) { return Bound::ASSUMED; },
- [&](const parser::TypeParamValue::Deferred &x) {
- return Bound::DEFERRED;
+ [](const parser::ScalarIntExpr &x) { return ParamValue{GetExpr(x)}; },
+ [](const parser::Star &) { return ParamValue::Assumed(); },
+ [](const parser::TypeParamValue::Deferred &) {
+ return ParamValue::Deferred();
},
},
- x.u));
+ x.u);
}
bool DeclTypeSpecVisitor::Pre(const parser::DeclarationTypeSpec::Record &x) {
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};
+ 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);
}
bool ArraySpecVisitor::Pre(const parser::ExplicitShapeSpec &x) {
- const auto &lb{std::get<std::optional<parser::SpecificationExpr>>(x.t)};
- const auto &ub{GetBound(std::get<parser::SpecificationExpr>(x.t))};
- arraySpec_.push_back(lb ? ShapeSpec::MakeExplicit(GetBound(*lb), ub)
- : ShapeSpec::MakeExplicit(ub));
+ 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;
}
}
Bound ArraySpecVisitor::GetBound(const parser::SpecificationExpr &x) {
- return Bound(IntExpr{}); // TODO: convert x.v to IntExpr
+ return Bound{GetExpr(x.v)};
}
// ScopeHandler implementation
const auto &name{std::get<parser::ObjectName>(x.t).source};
// TODO: CoarraySpec, CharLength, Initialization
Attrs attrs{attrs_ ? *attrs_ : Attrs{}};
- DeclareUnknownEntity(name, attrs);
+ 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));
+ }
+ }
+ }
}
void DeclarationVisitor::Post(const parser::PointerDecl &x) {
}
bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) {
auto &name{std::get<parser::NamedConstant>(x.t).v.source};
- // TODO: auto &expr{std::get<parser::ConstantExpr>(x.t)};
- // TODO: old-style parameters: type based on expr
auto &symbol{HandleAttributeStmt(Attr::PARAMETER, name)};
+ if (!ConvertToObjectEntity(symbol)) {
+ Say2(name, "PARAMETER attribute not allowed on '%s'"_err_en_US,
+ symbol.name(), "Declaration of '%s'"_en_US);
+ return false;
+ }
+ const auto &expr{std::get<parser::ConstantExpr>(x.t)};
+ symbol.get<ObjectEntityDetails>().set_init(GetExpr(expr));
ApplyImplicitRules(symbol);
return false;
}
auto attr{std::get<common::TypeParamAttr>(x.t)};
for (auto &decl : std::get<std::list<parser::TypeParamDecl>>(x.t)) {
auto &name{std::get<parser::Name>(decl.t).source};
- // TODO: initialization
- // auto &init{
- // std::get<std::optional<parser::ScalarIntConstantExpr>>(decl.t)};
- auto &symbol{MakeTypeSymbol(name, TypeParamDetails{attr})};
+ auto details{TypeParamDetails{attr}};
+ if (auto &init{
+ std::get<std::optional<parser::ScalarIntConstantExpr>>(decl.t)}) {
+ details.set_init(GetExpr(*init));
+ }
+ auto &symbol{MakeTypeSymbol(name, std::move(details))};
SetType(name, symbol, *type);
}
EndDecl();
attrs.set(Attr::PRIVATE);
}
if (OkToAddComponent(name)) {
- DeclareObjectEntity(name, attrs);
+ auto &symbol{DeclareObjectEntity(name, attrs)};
+ 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));
+ }
+ }
+ }
}
ClearArraySpec();
}
},
x.u);
}
+
template<typename T>
void ResolveNamesVisitor::Post(const parser::LoopBounds<T> &x) {
ResolveName(x.name.thing.thing.source);
},
genericSpec.u);
}
+
+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;
+ }
CheckDoConcurrentConstraints(context_.messages(), program_);
if (AnyFatalError()) {
return false;
void ObjectEntityDetails::set_shape(const ArraySpec &shape) {
CHECK(shape_.empty());
for (const auto &shapeSpec : shape) {
- shape_.push_back(shapeSpec);
+ shape_.emplace_back(shapeSpec.Clone());
}
}
}
}
+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();
}
}
+DeclTypeSpec *Symbol::GetType() {
+ return const_cast<DeclTypeSpec *>(
+ const_cast<const Symbol *>(this)->GetType());
+}
+
const DeclTypeSpec *Symbol::GetType() const {
return std::visit(
common::visitors{
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_;
+ }
return os;
}
os << ' ' << *x.type();
}
os << ' ' << common::EnumToString(x.attr());
+ if (x.init().Get()) {
+ os << " init:" << x.init();
+ }
},
[&](const MiscDetails &x) {
os << ' ' << MiscDetails::EnumToString(x.kind());
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 &);
const std::optional<DeclTypeSpec> &type() const { return type_; }
void set_type(const DeclTypeSpec &type);
+ ArraySpec &shape() { return shape_; }
const ArraySpec &shape() const { return shape_; }
void set_shape(const ArraySpec &shape);
bool isDummy() const { return isDummy_; }
private:
bool isDummy_;
+ LazyExpr 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 &);
const std::optional<DeclTypeSpec> &type() const { return type_; }
void set_type(const DeclTypeSpec &type) {
CHECK(!type_);
private:
common::TypeParamAttr attr_;
+ LazyExpr init_;
std::optional<DeclTypeSpec> type_;
};
Symbol &GetUltimate();
const Symbol &GetUltimate() const;
+ DeclTypeSpec *GetType();
const DeclTypeSpec *GetType() const;
void SetType(const DeclTypeSpec &);
#include "type.h"
#include "scope.h"
+#include "semantics.h"
#include "symbol.h"
+#include "../evaluate/fold.h"
+#include "../evaluate/tools.h"
#include "../evaluate/type.h"
#include "../parser/characters.h"
namespace Fortran::semantics {
-IntExpr::~IntExpr() {}
+LazyExpr::LazyExpr(SomeExpr &&expr) : u_{CopyableExprPtr{std::move(expr)}} {}
-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_;
-}
+MaybeExpr LazyExpr::Get() { return static_cast<const LazyExpr *>(this)->Get(); }
-std::unordered_map<std::uint64_t, IntConst> IntConst::cache;
+const MaybeExpr LazyExpr::Get() const {
+ if (auto *ptr{std::get_if<CopyableExprPtr>(&u_)}) {
+ return **ptr;
+ } else {
+ return std::nullopt;
+ }
+}
-const IntConst &IntConst::Make(std::uint64_t value) {
- auto it{cache.find(value)};
- if (it == cache.end()) {
- it = cache.insert({value, IntConst{value}}).first;
+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 it->second;
+ 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->Dump(o); },
+ },
+ x.u_);
+ return o;
}
void DerivedTypeSpec::set_scope(const Scope &scope) {
}
std::ostream &operator<<(std::ostream &o, const DerivedTypeSpec &x) {
- return o << "TYPE(" << x.name().ToString() << ')';
+ o << "TYPE(" << x.name().ToString();
+ if (!x.paramValues_.empty()) {
+ bool first = true;
+ o << '(';
+ for (auto &pair : x.paramValues_) {
+ if (first) {
+ first = false;
+ } else {
+ o << ',';
+ }
+ if (auto &name{pair.first}) {
+ o << name->ToString() << '=';
+ }
+ o << pair.second;
+ }
+ o << ')';
+ }
+ return o << ')';
}
-const Bound Bound::ASSUMED{Bound::Assumed};
-const Bound Bound::DEFERRED{Bound::Deferred};
+Bound::Bound(int bound)
+ : category_{Category::Explicit},
+ expr_{SomeExpr{evaluate::AsExpr(
+ evaluate::Constant<evaluate::SubscriptInteger>{bound})}} {}
+
+void Bound::Resolve(SemanticsContext &context) {
+ if (isExplicit()) {
+ expr_.Resolve(context);
+ }
+}
std::ostream &operator<<(std::ostream &o, const Bound &x) {
if (x.isAssumed()) {
} else if (x.isDeferred()) {
o << ':';
} else {
- x.expr_->Output(o);
+ o << x.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 {
+ o << x.GetExplicit();
+ }
+ return o;
+}
+
IntrinsicTypeSpec::IntrinsicTypeSpec(TypeCategory category, int kind)
: category_{category}, kind_{kind} {
CHECK(category != TypeCategory::Derived);
std::ostream &operator<<(std::ostream &o, const DeclTypeSpec &x) {
switch (x.category()) {
case DeclTypeSpec::Intrinsic: return o << x.intrinsicTypeSpec();
- case DeclTypeSpec::TypeDerived:
- return o << "TYPE(" << x.derivedTypeSpec().name().ToString() << ')';
+ case DeclTypeSpec::TypeDerived: return o << x.derivedTypeSpec();
case DeclTypeSpec::ClassDerived:
return o << "CLASS(" << x.derivedTypeSpec().name().ToString() << ')';
case DeclTypeSpec::TypeStar: return o << "TYPE(*)";
default: CRASH_NO_CASE;
}
}
+
+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 & [ name, value ] : dts.paramValues()) {
+ 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();
+}
}
#include "attr.h"
#include "../common/fortran.h"
#include "../common/idioms.h"
+#include "../common/indirection.h"
+#include "../evaluate/expression.h"
#include "../parser/char-block.h"
#include <list>
#include <memory>
#include <ostream>
#include <string>
#include <unordered_map>
+#include <variant>
+
+namespace Fortran::parser {
+class Expr;
+}
namespace Fortran::semantics {
class Scope;
class Symbol;
+class SemanticsContext;
+class ExprResolver;
/// 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;
+using SomeExpr = evaluate::Expr<evaluate::SomeType>;
+using MaybeExpr = std::optional<SomeExpr>;
-// TODO
-class IntExpr {
-public:
- static IntExpr MakeConst(std::uint64_t value) {
- return IntExpr(); // TODO
- }
- IntExpr() {}
- virtual ~IntExpr();
- virtual std::ostream &Output(std::ostream &o) const { return o << "IntExpr"; }
-};
-
-// TODO
-class IntConst {
+// 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:
- static const IntConst &Make(std::uint64_t 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::uint64_t value() const { return value_; }
- std::ostream &Output(std::ostream &o) const { return o << this->value_; }
+ 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:
- 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 &);
+ 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 const Bound ASSUMED;
- static const Bound DEFERRED;
- 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 {
- CHECK(isExplicit());
- return *expr_;
- }
+ 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(int bound);
+ Bound(Bound &&) = default;
+ Bound &operator=(Bound &&) = default;
+ Bound Clone() const { return Bound(category_, expr_.Clone()); }
+ 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 &);
private:
- enum Category { Explicit, Deferred, Assumed };
- Bound(Category category) : category_{category}, expr_{std::nullopt} {}
+ enum class Category { Explicit, Deferred, Assumed };
+ Bound(Category category) : category_{category} {}
+ Bound(Category category, LazyExpr &&expr)
+ : category_{category}, expr_{std::move(expr)} {}
Category category_;
- std::optional<IntExpr> expr_;
+ LazyExpr expr_;
friend std::ostream &operator<<(std::ostream &, const Bound &);
};
class ShapeSpec {
public:
// lb:ub
- static ShapeSpec MakeExplicit(const Bound &lb, const Bound &ub) {
- return ShapeSpec(lb, ub);
+ static ShapeSpec MakeExplicit(Bound &&lb, Bound &&ub) {
+ return ShapeSpec(std::move(lb), std::move(ub));
}
// 1:ub
- static const ShapeSpec MakeExplicit(const Bound &ub) {
- return MakeExplicit(IntExpr::MakeConst(1), ub);
+ static const ShapeSpec MakeExplicit(Bound &&ub) {
+ return MakeExplicit(Bound{1}, std::move(ub));
+ }
+ // 1:
+ static ShapeSpec MakeAssumed() {
+ return ShapeSpec(Bound{1}, Bound::Deferred());
}
- // 1: or lb:
- static ShapeSpec MakeAssumed(const Bound &lb = IntExpr::MakeConst(1)) {
- return ShapeSpec(lb, Bound::DEFERRED);
+ // lb:
+ static ShapeSpec MakeAssumed(Bound &&lb) {
+ return ShapeSpec(std::move(lb), Bound::Deferred());
}
// :
static ShapeSpec MakeDeferred() {
- return ShapeSpec(Bound::DEFERRED, Bound::DEFERRED);
+ return ShapeSpec(Bound::Deferred(), Bound::Deferred());
}
- // 1:* or lb:*
- static ShapeSpec MakeImplied(const Bound &lb = IntExpr::MakeConst(1)) {
- return ShapeSpec(lb, Bound::ASSUMED);
+ // 1:*
+ static ShapeSpec MakeImplied() {
+ return ShapeSpec(Bound{1}, Bound::Assumed());
+ }
+ // lb:*
+ static ShapeSpec MakeImplied(Bound &&lb) {
+ return ShapeSpec(std::move(lb), Bound::Assumed());
}
// ..
static ShapeSpec MakeAssumedRank() {
- return ShapeSpec(Bound::ASSUMED, Bound::ASSUMED);
+ return ShapeSpec(Bound::Assumed(), Bound::Assumed());
}
+ ShapeSpec(ShapeSpec &&) = default;
+ ShapeSpec &operator=(ShapeSpec &&) = default;
+ ShapeSpec Clone() const { return ShapeSpec{lb_.Clone(), ub_.Clone()}; }
+
bool isExplicit() const { return ub_.isExplicit(); }
bool isDeferred() const { return lb_.isDeferred(); }
-
const Bound &lbound() const { return lb_; }
const Bound &ubound() const { return ub_; }
private:
- ShapeSpec(const Bound &lb, const Bound &ub) : lb_{lb}, ub_{ub} {}
+ ShapeSpec(Bound &&lb, Bound &&ub) : lb_{std::move(lb)}, ub_{std::move(ub)} {}
Bound lb_;
Bound ub_;
+ friend ExprResolver;
friend std::ostream &operator<<(std::ostream &, const ShapeSpec &);
};
friend std::ostream &operator<<(std::ostream &, const GenericSpec &);
};
-// The value of a len type parameter
-using LenParamValue = Bound;
+// A type parameter value: integer expression or assumed or deferred.
+class ParamValue {
+public:
+ static const ParamValue Assumed() { return ParamValue(Category::Assumed); }
+ static const ParamValue Deferred() { return ParamValue(Category::Deferred); }
+ ParamValue(const parser::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 &);
-using ParamValue = LenParamValue;
+private:
+ enum class Category { Explicit, Deferred, Assumed };
+ ParamValue(Category category) : category_{category} {}
+ Category category_;
+ LazyExpr expr_;
+ friend std::ostream &operator<<(std::ostream &, const ParamValue &);
+};
class DerivedTypeSpec {
public:
+ using listType = std::list<std::pair<std::optional<SourceName>, ParamValue>>;
explicit DerivedTypeSpec(const SourceName &name) : name_{&name} {}
DerivedTypeSpec() = delete;
const SourceName &name() const { return *name_; }
const Scope *scope() const { return scope_; }
void set_scope(const Scope &);
+ listType ¶mValues() { return paramValues_; }
+ const listType ¶mValues() const { return paramValues_; }
+ void AddParamValue(ParamValue &&value) {
+ paramValues_.emplace_back(std::nullopt, std::move(value));
+ }
+ void AddParamValue(const SourceName &name, ParamValue &&value) {
+ paramValues_.emplace_back(name, std::move(value));
+ }
private:
const SourceName *name_;
const Scope *scope_{nullptr};
- std::list<std::pair<std::optional<SourceName>, ParamValue>> paramValues_;
+ listType paramValues_;
friend std::ostream &operator<<(std::ostream &, const DerivedTypeSpec &);
};
const Symbol *symbol_{nullptr};
std::optional<DeclTypeSpec> type_;
};
+
+// Resolve expressions in symbols.
+void ResolveSymbolExprs(SemanticsContext &);
}
#endif // FORTRAN_SEMANTICS_TYPE_H_
)
target_link_libraries(expression-test
- FortranEvaluate
FortranEvaluateTesting
+ FortranEvaluate
FortranParser
+ FortranSemantics
+ FortranEvaluate
)
add_executable(integer-test
)
target_link_libraries(intrinsics-test
- FortranEvaluate
FortranEvaluateTesting
+ FortranEvaluate
FortranParser
+ FortranSemantics
+ FortranRuntime
)
add_executable(logical-test
)
target_link_libraries(reshape-test
+ FortranSemantics
FortranEvaluate
FortranEvaluateTesting
FortranRuntime
modfile09-*.f90
modfile10.f90
modfile11.f90
+ modfile12.f90
)
set(LABEL_TESTS
--- /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.
+
+module m
+ integer(8), parameter :: a = 1, b = 2_8
+ parameter(n=3)
+ 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
+contains
+ subroutine foo(x)
+ real :: x(2:)
+ end
+ subroutine bar(x)
+ real :: x(..)
+ end
+end
+
+!Expect: m.mod
+!module m
+! integer(8),parameter::a=1_4
+! integer(8),parameter::b=2_8
+! integer(4),parameter::n=3_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
+!contains
+! subroutine foo(x)
+! real(4)::x(2_4:)
+! end
+! subroutine bar(x)
+! real(4)::x(..)
+! end
+!end
!ERROR: EXTERNAL attribute not allowed on 'bar'
external :: bar
+ !ERROR: PARAMETER attribute not allowed on 'm'
+ parameter(m=2)
+ !ERROR: PARAMETER attribute not allowed on 'foo'
+ parameter(foo=2)
+ !ERROR: PARAMETER attribute not allowed on 'bar'
+ parameter(bar=2)
+
contains
subroutine bar
end subroutine
integer :: a
end type t
!REF: /s4/t
- !DEF: /s4/x ObjectEntity TYPE(t)
+ !DEF: /s4/x ObjectEntity TYPE(t(1_4))
type(t(1)) :: x
!REF: /s4/x
!REF: /s4/t
integer, len :: l
end type t
!REF: /s5/t
- !DEF: /s5/x ALLOCATABLE ObjectEntity TYPE(t)
+ !DEF: /s5/x ALLOCATABLE ObjectEntity TYPE(t(:))
type(t(:)), allocatable :: x
!DEF: /s5/y ALLOCATABLE ObjectEntity REAL(4)
real, allocatable :: y
projects / platform / upstream / llvm.git / commitdiff