#include "assignment.h"
#include "expression.h"
-#include "semantics.h"
#include "symbol.h"
#include "../common/idioms.h"
#include "../evaluate/expression.h"
explicit AssignmentContext(
SemanticsContext &c, parser::CharBlock at = parser::CharBlock{})
: context_{c}, messages_{at, &c.messages()} {}
- AssignmentContext(const AssignmentContext &that, parser::CharBlock at)
- : context_{that.context_}, messages_{at, that.messages_.messages()},
- where_{that.where_}, forall_{that.forall_} {}
AssignmentContext(const AssignmentContext &c, WhereContext &w)
: context_{c.context_}, messages_{c.messages_}, where_{&w} {}
AssignmentContext(const AssignmentContext &c, ForallContext &f)
: context_{c.context_}, messages_{c.messages_}, forall_{&f} {}
+ bool operator==(const AssignmentContext &x) const { return this == &x; }
+ bool operator!=(const AssignmentContext &x) const { return this != &x; }
+
void Analyze(const parser::AssignmentStmt &);
void Analyze(const parser::PointerAssignmentStmt &);
void Analyze(const parser::WhereStmt &);
void Analyze(const parser::ConcurrentHeader &);
template<typename A> void Analyze(const parser::Statement<A> &stmt) {
- AssignmentContext nested{*this, stmt.source};
- nested.Analyze(stmt.statement);
+ const auto *saveLocation{context_.location()};
+ context_.set_location(&stmt.source);
+ Analyze(stmt.statement);
+ context_.set_location(saveLocation);
}
template<typename A> void Analyze(const common::Indirection<A> &x) {
Analyze(x.value());
ForallContext *forall_{nullptr};
};
+} // namespace Fortran::semantics
+
+DEFINE_OWNING_DESTRUCTOR(ForwardReference, semantics::AssignmentContext)
+
+namespace Fortran::semantics {
+
void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
if (forall_ != nullptr) {
// TODO: Warn if some name in forall_->activeNames or its outer
ForallContext forall{forall_};
AssignmentContext nested{*this, forall};
const auto &forallStmt{
- std::get<parser::Statement<parser::ForallConstructStmt>>(construct.t)
- .statement};
- nested.Analyze(
- std::get<common::Indirection<parser::ConcurrentHeader>>(forallStmt.t));
+ std::get<parser::Statement<parser::ForallConstructStmt>>(construct.t)};
+ context_.set_location(&forallStmt.source);
+ nested.Analyze(std::get<common::Indirection<parser::ConcurrentHeader>>(
+ forallStmt.statement.t));
for (const auto &body :
std::get<std::list<parser::ForallBodyConstruct>>(construct.t)) {
nested.Analyze(body.u);
CHECK(where_ != nullptr);
const auto &elsewhereStmt{
std::get<parser::Statement<parser::MaskedElsewhereStmt>>(elsewhere.t)};
+ context_.set_location(&elsewhereStmt.source);
MaskExpr mask{
GetMask(std::get<parser::LogicalExpr>(elsewhereStmt.statement.t))};
MaskExpr copyCumulative{where_->cumulativeMaskExpr};
const std::optional<parser::IntegerTypeSpec> &spec) {
std::optional<parser::KindSelector> empty;
evaluate::Expr<evaluate::SubscriptInteger> kind{AnalyzeKindSelector(
- context_, messages_.at(), TypeCategory::Integer, spec ? spec->v : empty)};
+ context_, TypeCategory::Integer, spec ? spec->v : empty)};
if (auto value{evaluate::ToInt64(kind)}) {
return static_cast<int>(*value);
} else {
AssignmentContext{context}.Analyze(header);
}
+AssignmentChecker::AssignmentChecker(SemanticsContext &context)
+ : context_{new AssignmentContext{context}} {}
+void AssignmentChecker::Enter(const parser::AssignmentStmt &x) {
+ context_.value().Analyze(x);
+}
+void AssignmentChecker::Enter(const parser::PointerAssignmentStmt &x) {
+ context_.value().Analyze(x);
+}
+void AssignmentChecker::Enter(const parser::WhereStmt &x) {
+ context_.value().Analyze(x);
+}
+void AssignmentChecker::Enter(const parser::WhereConstruct &x) {
+ context_.value().Analyze(x);
+}
+void AssignmentChecker::Enter(const parser::ForallStmt &x) {
+ context_.value().Analyze(x);
+}
+void AssignmentChecker::Enter(const parser::ForallConstruct &x) {
+ context_.value().Analyze(x);
+}
+
namespace {
class Visitor {
public:
private:
SemanticsContext &context_;
};
-}
-void AnalyzeAssignments(parser::Program &program, SemanticsContext &context) {
- Visitor visitor{context};
- parser::Walk(program, visitor);
-}
}
+
+} // namespace Fortran::semantics
#ifndef FORTRAN_SEMANTICS_ASSIGNMENT_H_
#define FORTRAN_SEMANTICS_ASSIGNMENT_H_
+#include "semantics.h"
+#include "../common/indirection.h"
+
namespace Fortran::parser {
template<typename> struct Statement;
struct AssignmentStmt;
struct PointerAssignmentStmt;
struct Program;
struct WhereStmt;
+struct WhereConstruct;
+struct ForallStmt;
+struct ForallConstruct;
}
namespace Fortran::semantics {
-class SemanticsContext;
+class AssignmentContext;
+
+class AssignmentChecker : public virtual BaseChecker {
+public:
+ explicit AssignmentChecker(SemanticsContext &);
+ void Enter(const parser::AssignmentStmt &);
+ void Enter(const parser::PointerAssignmentStmt &);
+ void Enter(const parser::WhereStmt &);
+ void Enter(const parser::WhereConstruct &);
+ void Enter(const parser::ForallStmt &);
+ void Enter(const parser::ForallConstruct &);
+
+private:
+ common::ForwardReference<AssignmentContext> context_;
+};
// Semantic analysis of an assignment statement or WHERE/FORALL construct.
void AnalyzeAssignment(
void AnalyzeConcurrentHeader(
SemanticsContext &, const parser::ConcurrentHeader &);
-// Semantic analysis of all assignment statements and related constructs.
-void AnalyzeAssignments(parser::Program &, SemanticsContext &);
}
#endif // FORTRAN_SEMANTICS_ASSIGNMENT_H_
#include "check-do-concurrent.h"
#include "attr.h"
#include "scope.h"
+#include "semantics.h"
#include "symbol.h"
#include "type.h"
#include "../parser/message.h"
}
// Find a canonical DO CONCURRENT and enforce semantics checks on its body
-class FindDoConcurrentLoops {
+class DoConcurrentContext {
public:
- FindDoConcurrentLoops(parser::Messages &messages) : messages_{messages} {}
- template<typename T> constexpr bool Pre(const T &) { return true; }
- template<typename T> constexpr void Post(const T &) {}
- void Post(const parser::DoConstruct &doConstruct) {
+ DoConcurrentContext(SemanticsContext &context)
+ : messages_{context.messages()} {}
+
+ bool operator==(const DoConcurrentContext &x) const { return this == &x; }
+ bool operator!=(const DoConcurrentContext &x) const { return this != &x; }
+
+ void Check(const parser::DoConstruct &doConstruct) {
auto &doStmt{
std::get<parser::Statement<parser::NonLabelDoStmt>>(doConstruct.t)};
auto &optionalLoopControl{
parser::CharBlock currentStatementSourcePosition_;
};
+} // namespace Fortran::semantics
+
+DEFINE_OWNING_DESTRUCTOR(ForwardReference, semantics::DoConcurrentContext)
+
+namespace Fortran::semantics {
+
+DoConcurrentChecker::DoConcurrentChecker(SemanticsContext &context)
+ : context_{new DoConcurrentContext{context}} {}
+
// DO loops must be canonicalized prior to calling
-void CheckDoConcurrentConstraints(
- parser::Messages &messages, const parser::Program &program) {
- FindDoConcurrentLoops findDoConcurrentLoops{messages};
- Walk(program, findDoConcurrentLoops);
-}
+void DoConcurrentChecker::Leave(const parser::DoConstruct &x) {
+ context_.value().Check(x);
}
+
+} // namespace Fortran::semantics
-// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
+// Copyright (c) 2018-2019, 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.
#ifndef FORTRAN_SEMANTICS_CHECK_DO_CONCURRENT_H_
#define FORTRAN_SEMANTICS_CHECK_DO_CONCURRENT_H_
+#include "semantics.h"
+#include "../common/indirection.h"
+
namespace Fortran::parser {
-class Messages;
-struct Program;
+struct DoConstruct;
}
namespace Fortran::semantics {
+class DoConcurrentContext;
+
+class DoConcurrentChecker : public virtual BaseChecker {
+public:
+ explicit DoConcurrentChecker(SemanticsContext &);
+ void Leave(const parser::DoConstruct &);
+
+private:
+ common::ForwardReference<DoConcurrentContext> context_;
+};
-void CheckDoConcurrentConstraints(
- parser::Messages &messages, const parser::Program &program);
}
#endif // FORTRAN_SEMANTICS_CHECK_DO_CONCURRENT_H_
MaybeExpr ExpressionAnalysisContext::Analyze(const parser::Expr &expr) {
if (expr.typedExpr.has_value()) {
- // Expression was already checked by AnalyzeExpressions() below.
+ // Expression was already checked by ExprChecker
return std::make_optional<Expr<SomeType>>(expr.typedExpr.value().v);
} else if (!expr.source.empty()) {
// Analyze the expression in a specified source position context for better
namespace Fortran::semantics {
-namespace {
-class Visitor {
-public:
- Visitor(SemanticsContext &context) : context_{context} {}
-
- template<typename A> bool Pre(const A &) { return true /* visit children */; }
- template<typename A> void Post(const A &) {}
+evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
+ SemanticsContext &context, common::TypeCategory category,
+ const std::optional<parser::KindSelector> &selector) {
+ evaluate::ExpressionAnalysisContext exprContext{context};
+ auto save{
+ exprContext.GetContextualMessages().SetLocation(*context.location())};
+ return exprContext.Analyze(category, selector);
+}
- bool Pre(const parser::Expr &expr) {
- if (!expr.typedExpr.has_value()) {
- if (MaybeExpr checked{AnalyzeExpr(context_, expr)}) {
+void ExprChecker::Enter(const parser::Expr &expr) {
+ if (!expr.typedExpr.has_value()) {
+ if (MaybeExpr checked{AnalyzeExpr(context_, expr)}) {
#if PMKDEBUG
// checked->AsFortran(std::cout << "checked expression: ") << '\n';
#endif
- expr.typedExpr = new evaluate::GenericExprWrapper{std::move(*checked)};
- } else {
+ expr.typedExpr = new evaluate::GenericExprWrapper{std::move(*checked)};
+ } else {
#if PMKDEBUG
- std::cout << "TODO: expression analysis failed for this expression: ";
- DumpTree(std::cout, expr);
+ std::cout << "TODO: expression analysis failed for this expression: ";
+ DumpTree(std::cout, expr);
#endif
- }
}
- return false;
}
-
-private:
- SemanticsContext &context_;
-};
-}
-
-void AnalyzeExpressions(parser::Program &program, SemanticsContext &context) {
- Visitor visitor{context};
- parser::Walk(program, visitor);
}
-evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
- SemanticsContext &context, parser::CharBlock source,
- common::TypeCategory category,
- const std::optional<parser::KindSelector> &selector) {
- evaluate::ExpressionAnalysisContext exprContext{context};
- auto save{exprContext.GetContextualMessages().SetLocation(source)};
- return exprContext.Analyze(category, selector);
-}
}
left.Rank(), right.Rank());
}
}
-}
+
+} // namespace Fortran::evaluate
namespace Fortran::semantics {
return AnalyzeExpr(exprContext, expr);
}
-// Semantic analysis of all expressions in a parse tree, which is
-// decorated with typed representations for top-level expressions.
-void AnalyzeExpressions(parser::Program &, SemanticsContext &);
-
// Semantic analysis of an intrinsic type's KIND parameter expression.
evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
- SemanticsContext &, parser::CharBlock, common::TypeCategory,
+ SemanticsContext &, common::TypeCategory,
const std::optional<parser::KindSelector> &);
-}
+
+// Semantic analysis of all expressions in a parse tree, which is
+// decorated with typed representations for top-level expressions.
+class ExprChecker : public virtual BaseChecker {
+public:
+ explicit ExprChecker(SemanticsContext &context) : context_{context} {}
+ void Enter(const parser::Expr &);
+
+private:
+ SemanticsContext &context_;
+};
+
+} // namespace Fortran::semantics
+
#endif // FORTRAN_SEMANTICS_EXPRESSION_H_
// Track statement source locations and save messages.
class MessageHandler {
public:
- Messages &messages() { return *messages_; };
- void set_messages(Messages &messages) { messages_ = &messages; }
- const SourceName *currStmtSource() { return currStmtSource_; }
- void set_currStmtSource(const SourceName *);
+ Messages &messages() { return context_->messages(); };
+ void set_context(SemanticsContext &context) { context_ = &context; }
+ const SourceName *currStmtSource() { return context_->location(); }
+ void set_currStmtSource(const SourceName *source) {
+ context_->set_location(source);
+ }
// Emit a message associated with the current statement source.
Message &Say(MessageFixedText &&);
const SourceName &);
private:
- // Where messages are emitted:
- Messages *messages_{nullptr};
- // Source location of current statement; null if not in a statement
- const SourceName *currStmtSource_{nullptr};
+ SemanticsContext *context_{nullptr};
};
// Inheritance graph for the parse tree visitation classes that follow:
void set_this(ResolveNamesVisitor *x) { this_ = x; }
MessageHandler &messageHandler() { return messageHandler_; }
- const SourceName *currStmtSource();
+ const SourceName *currStmtSource() { return context_->location(); }
SemanticsContext &context() const { return *context_; }
void set_context(SemanticsContext &);
evaluate::FoldingContext &GetFoldingContext() const {
parser::Walk(x, *this_);
}
-const SourceName *BaseVisitor::currStmtSource() {
- return messageHandler_.currStmtSource();
-}
-
void BaseVisitor::set_context(SemanticsContext &context) {
context_ = &context;
- messageHandler_.set_messages(context.messages());
+ messageHandler_.set_context(context);
}
void BaseVisitor::MakePlaceholder(
KindExpr DeclTypeSpecVisitor::GetKindParamExpr(
TypeCategory category, const std::optional<parser::KindSelector> &kind) {
- return AnalyzeKindSelector(context(), *currStmtSource(), category, kind);
+ return AnalyzeKindSelector(context(), category, kind);
}
// MessageHandler implementation
-void MessageHandler::set_currStmtSource(const SourceName *source) {
- currStmtSource_ = source;
-}
Message &MessageHandler::Say(MessageFixedText &&msg) {
- CHECK(currStmtSource_);
- return messages_->Say(*currStmtSource_, std::move(msg));
+ return context_->Say(*currStmtSource(), std::move(msg));
}
Message &MessageHandler::Say(MessageFormattedText &&msg) {
- CHECK(currStmtSource_);
- return messages_->Say(*currStmtSource_, std::move(msg));
+ return context_->Say(*currStmtSource(), std::move(msg));
}
Message &MessageHandler::Say(const SourceName &name, MessageFixedText &&msg) {
return Say(name, std::move(msg), name);
}
Message &MessageHandler::Say(const SourceName &location, MessageFixedText &&msg,
const SourceName &arg1) {
- return messages_->Say(location, std::move(msg), arg1.ToString().c_str());
+ return context_->Say(location, std::move(msg), arg1.ToString().c_str());
}
Message &MessageHandler::Say(const SourceName &location, MessageFixedText &&msg,
const SourceName &arg1, const SourceName &arg2) {
- return messages_->Say(location, std::move(msg), arg1.ToString().c_str(),
+ return context_->Say(location, std::move(msg), arg1.ToString().c_str(),
arg2.ToString().c_str());
}
#include "scope.h"
#include "symbol.h"
#include "../common/default-kinds.h"
+#include "../parser/parse-tree-visitor.h"
#include <ostream>
namespace Fortran::semantics {
static void DoDumpSymbols(std::ostream &, const Scope &, int indent = 0);
static void PutIndent(std::ostream &, int indent);
+// A parse tree visitor that calls Enter/Leave functions from each checker
+// class C supplied as template parameters. Enter is called before the node's
+// children are visited, Leave is called after. No two checkers may have the
+// same Enter or Leave function. Each checker must be constructible from
+// SemanticsContext and have BaseChecker as a virtual base class.
+template<typename... C> struct SemanticsVisitor : public virtual C... {
+ using C::Enter...;
+ using C::Leave...;
+ using BaseChecker::Enter;
+ using BaseChecker::Leave;
+ SemanticsVisitor(SemanticsContext &context) : C{context}... {}
+ template<typename N> bool Pre(const N &node) {
+ Enter(node);
+ return true;
+ }
+ template<typename N> void Post(const N &node) { Leave(node); }
+};
+
+using StatementSemantics =
+ SemanticsVisitor<ExprChecker, AssignmentChecker, DoConcurrentChecker>;
+
SemanticsContext::SemanticsContext(
const common::IntrinsicTypeDefaultKinds &defaultKinds)
: defaultKinds_{defaultKinds},
if (AnyFatalError()) {
return false;
}
- CheckDoConcurrentConstraints(context_.messages(), program_);
- AnalyzeExpressions(program_, context_);
- AnalyzeAssignments(program_, context_);
+ StatementSemantics visitor{context_};
+ parser::Walk(program_, visitor);
if (AnyFatalError()) {
return false;
}
os << " ";
}
}
+
}
const common::IntrinsicTypeDefaultKinds &defaultKinds() const {
return defaultKinds_;
}
+ const parser::CharBlock *location() const { return location_; }
const std::vector<std::string> &searchDirectories() const {
return searchDirectories_;
}
parser::Messages &messages() { return messages_; }
evaluate::FoldingContext &foldingContext() { return foldingContext_; }
+ SemanticsContext &set_location(const parser::CharBlock *location) {
+ location_ = location;
+ return *this;
+ }
SemanticsContext &set_searchDirectories(const std::vector<std::string> &x) {
searchDirectories_ = x;
return *this;
private:
const common::IntrinsicTypeDefaultKinds &defaultKinds_;
+ const parser::CharBlock *location_{nullptr};
std::vector<std::string> searchDirectories_;
std::string moduleDirectory_{"."s};
bool warnOnNonstandardUsage_{false};
parser::Program &program_;
const parser::CookedSource &cooked_;
};
-}
+// Base class for semantics checkers.
+struct BaseChecker {
+ template<typename C> void Enter(const C &x) {}
+ template<typename C> void Leave(const C &x) {}
+};
+
+}
#endif