From: Tim Keith <tkeith@nvidia.com>
Date: Wed, 6 Mar 2019 00:52:50 +0000 (-0800)
Subject: [flang] Create framework for checking statement semantics
X-Git-Tag: llvmorg-12-init~9537^2~1675
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=813e48dc2165f11d3e1f4e1b39b44fa687496092;p=platform%2Fupstream%2Fllvm.git

[flang] Create framework for checking statement semantics

Add `SemanticsVisitor` as the visitor class to perform statement
semantics checks. Its template parameters are "checker" classes
that perform the checks. They have `Enter` and `Leave` functions
that are called for the corresponding parse tree nodes (`Enter`
before the children, `Leave` after). Unlike `Pre` and `Post` in
visitors they cannot prevent the parse tree walker from visiting
child nodes.

Existing checks have been incorporated into this framework:
- `ExprChecker` replaces `AnalyzeExpressions()`
- `AssignmentChecker` replaces `AnalyzeAssignments()`
- `DoConcurrentChecker` replaces `CheckDoConcurrentConstraints()`

Adding a new checker requires:
- defining the checker class:
  - with BaseChecker as virtual base class
  - constructible from `SemanticsContext`
  - with Enter/Leave functions for nodes of interest
- add the checker class to the template parameters of `StatementSemantics`

Because these checkers and also `ResolveNamesVisitor` require tracking
the current statement source location, that has been moved into
`SemanticsContext`. `ResolveNamesVisitor` and `SemanticsVisitor`
update the location when `Statement` nodes are encountered, making it
available for error messages.

`AnalyzeKindSelector()` now has access to the current statement through
the context and so no longer needs to have it passed in.

Test `assign01.f90` was added to verify that `AssignmentChecker` is
actually doing something.

Original-commit: flang-compiler/f18@3a222c36731029fabf026e5301dc60f0587595be
Reviewed-on: https://github.com/flang-compiler/f18/pull/315
Tree-same-pre-rewrite: false
---

diff --git a/flang/lib/semantics/assignment.cc b/flang/lib/semantics/assignment.cc
index 2defa86..6588c5a 100644
--- a/flang/lib/semantics/assignment.cc
+++ b/flang/lib/semantics/assignment.cc
@@ -14,7 +14,6 @@
 
 #include "assignment.h"
 #include "expression.h"
-#include "semantics.h"
 #include "symbol.h"
 #include "../common/idioms.h"
 #include "../evaluate/expression.h"
@@ -82,14 +81,14 @@ public:
   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 &);
@@ -99,8 +98,10 @@ public:
   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());
@@ -129,6 +130,12 @@ private:
   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
@@ -194,10 +201,10 @@ void AssignmentContext::Analyze(const parser::ForallConstruct &construct) {
   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);
@@ -209,6 +216,7 @@ void AssignmentContext::Analyze(
   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};
@@ -264,7 +272,7 @@ int AssignmentContext::GetIntegerKind(
     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 {
@@ -290,6 +298,27 @@ void AnalyzeConcurrentHeader(
   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:
@@ -326,10 +355,7 @@ public:
 private:
   SemanticsContext &context_;
 };
-}
 
-void AnalyzeAssignments(parser::Program &program, SemanticsContext &context) {
-  Visitor visitor{context};
-  parser::Walk(program, visitor);
-}
 }
+
+}  // namespace Fortran::semantics
diff --git a/flang/lib/semantics/assignment.h b/flang/lib/semantics/assignment.h
index 2e1c9ab..8b7d2989 100644
--- a/flang/lib/semantics/assignment.h
+++ b/flang/lib/semantics/assignment.h
@@ -15,6 +15,9 @@
 #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;
@@ -23,10 +26,27 @@ struct ForallStmt;
 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(
@@ -43,7 +63,5 @@ 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_
diff --git a/flang/lib/semantics/check-do-concurrent.cc b/flang/lib/semantics/check-do-concurrent.cc
index 527a790..6e06ba29 100644
--- a/flang/lib/semantics/check-do-concurrent.cc
+++ b/flang/lib/semantics/check-do-concurrent.cc
@@ -15,6 +15,7 @@
 #include "check-do-concurrent.h"
 #include "attr.h"
 #include "scope.h"
+#include "semantics.h"
 #include "symbol.h"
 #include "type.h"
 #include "../parser/message.h"
@@ -306,12 +307,15 @@ static CS GatherReferencesFromExpression(const parser::Expr &expression) {
 }
 
 // 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{
@@ -510,10 +514,18 @@ private:
   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
diff --git a/flang/lib/semantics/check-do-concurrent.h b/flang/lib/semantics/check-do-concurrent.h
index 6101762..8f20393 100644
--- a/flang/lib/semantics/check-do-concurrent.h
+++ b/flang/lib/semantics/check-do-concurrent.h
@@ -1,4 +1,4 @@
-// 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.
@@ -15,14 +15,24 @@
 #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_
diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc
index c6b6e85..71bb1d4 100644
--- a/flang/lib/semantics/expression.cc
+++ b/flang/lib/semantics/expression.cc
@@ -1975,7 +1975,7 @@ static MaybeExpr AnalyzeExpr(
 
 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
@@ -2088,47 +2088,29 @@ std::optional<int> ExpressionAnalysisContext::IsAcImpliedDo(
 
 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);
-}
 }
diff --git a/flang/lib/semantics/expression.h b/flang/lib/semantics/expression.h
index f865c08..51ab6ce 100644
--- a/flang/lib/semantics/expression.h
+++ b/flang/lib/semantics/expression.h
@@ -241,7 +241,8 @@ void ConformabilityCheck(
         left.Rank(), right.Rank());
   }
 }
-}
+
+}  // namespace Fortran::evaluate
 
 namespace Fortran::semantics {
 
@@ -253,13 +254,22 @@ std::optional<evaluate::Expr<evaluate::SomeType>> AnalyzeExpr(
   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_
diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index a4f09c2..f8f5017 100644
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -94,10 +94,12 @@ private:
 // 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 &&);
@@ -110,10 +112,7 @@ public:
       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:
@@ -136,7 +135,7 @@ public:
   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 {
@@ -1093,13 +1092,9 @@ template<typename T> void BaseVisitor::Walk(const T &x) {
   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(
@@ -1272,32 +1267,27 @@ void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) {
 
 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());
 }
 
diff --git a/flang/lib/semantics/semantics.cc b/flang/lib/semantics/semantics.cc
index f47de1c..d51823e 100644
--- a/flang/lib/semantics/semantics.cc
+++ b/flang/lib/semantics/semantics.cc
@@ -24,6 +24,7 @@
 #include "scope.h"
 #include "symbol.h"
 #include "../common/default-kinds.h"
+#include "../parser/parse-tree-visitor.h"
 #include <ostream>
 
 namespace Fortran::semantics {
@@ -31,6 +32,27 @@ 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},
@@ -80,9 +102,8 @@ bool Semantics::Perform() {
   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;
   }
@@ -134,4 +155,5 @@ static void PutIndent(std::ostream &os, int indent) {
     os << "  ";
   }
 }
+
 }
diff --git a/flang/lib/semantics/semantics.h b/flang/lib/semantics/semantics.h
index f949070..bf8df01 100644
--- a/flang/lib/semantics/semantics.h
+++ b/flang/lib/semantics/semantics.h
@@ -41,6 +41,7 @@ public:
   const common::IntrinsicTypeDefaultKinds &defaultKinds() const {
     return defaultKinds_;
   }
+  const parser::CharBlock *location() const { return location_; }
   const std::vector<std::string> &searchDirectories() const {
     return searchDirectories_;
   }
@@ -52,6 +53,10 @@ public:
   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;
@@ -81,6 +86,7 @@ public:
 
 private:
   const common::IntrinsicTypeDefaultKinds &defaultKinds_;
+  const parser::CharBlock *location_{nullptr};
   std::vector<std::string> searchDirectories_;
   std::string moduleDirectory_{"."s};
   bool warnOnNonstandardUsage_{false};
@@ -113,6 +119,12 @@ private:
   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