[flang] checkpoint during refactor
authorpeter klausler <pklausler@nvidia.com>
Fri, 30 Nov 2018 22:03:05 +0000 (14:03 -0800)
committerpeter klausler <pklausler@nvidia.com>
Fri, 30 Nov 2018 22:03:05 +0000 (14:03 -0800)
Original-commit: flang-compiler/f18@01fe82b95bebb5977fb5fa9c90ea1b8a6894a18c
Reviewed-on: https://github.com/flang-compiler/f18/pull/234
Tree-same-pre-rewrite: false

16 files changed:
flang/lib/evaluate/complex.cc
flang/lib/evaluate/complex.h
flang/lib/evaluate/decimal.cc
flang/lib/evaluate/decimal.h
flang/lib/evaluate/real.cc
flang/lib/evaluate/real.h
flang/lib/evaluate/type.h
flang/lib/semantics/CMakeLists.txt
flang/lib/semantics/assignment.cc [new file with mode: 0644]
flang/lib/semantics/assignment.h [new file with mode: 0644]
flang/lib/semantics/expression.cc
flang/lib/semantics/expression.h
flang/lib/semantics/semantics.cc
flang/lib/semantics/semantics.h
flang/lib/semantics/type.cc
flang/test/evaluate/real.cc

index d8d7562..a38500c 100644 (file)
@@ -103,6 +103,7 @@ std::ostream &Complex<R>::AsFortran(std::ostream &o, int kind) const {
 }
 
 template class Complex<Real<Integer<16>, 11>>;
+template class Complex<Real<Integer<16>, 8>>;
 template class Complex<Real<Integer<32>, 24>>;
 template class Complex<Real<Integer<64>, 53>>;
 template class Complex<Real<Integer<80>, 64, false>>;
index f1498fc..3d6f8be 100644 (file)
@@ -93,6 +93,7 @@ private:
 };
 
 extern template class Complex<Real<Integer<16>, 11>>;
+extern template class Complex<Real<Integer<16>, 8>>;
 extern template class Complex<Real<Integer<32>, 24>>;
 extern template class Complex<Real<Integer<64>, 53>>;
 extern template class Complex<Real<Integer<80>, 64, false>>;
index 3c22c2f..9536d84 100644 (file)
@@ -397,6 +397,7 @@ std::string Decimal<REAL, LOG10RADIX>::ToMinimalString(
 }
 
 template class Decimal<Real<Integer<16>, 11>>;
+template class Decimal<Real<Integer<16>, 8>>;
 template class Decimal<Real<Integer<32>, 24>>;
 template class Decimal<Real<Integer<64>, 53>>;
 template class Decimal<Real<Integer<80>, 64, false>>;
index 5748da0..1992083 100644 (file)
@@ -202,6 +202,7 @@ private:
 };
 
 extern template class Decimal<Real<Integer<16>, 11>>;
+extern template class Decimal<Real<Integer<16>, 8>>;
 extern template class Decimal<Real<Integer<32>, 24>>;
 extern template class Decimal<Real<Integer<64>, 53>>;
 extern template class Decimal<Real<Integer<80>, 64, false>>;
index 8c1561a..df7b38d 100644 (file)
@@ -460,8 +460,9 @@ std::ostream &Real<W, P, IM>::AsFortran(
 }
 
 template class Real<Integer<16>, 11>;
+template class Real<Integer<16>, 8>;
 template class Real<Integer<32>, 24>;
 template class Real<Integer<64>, 53>;
 template class Real<Integer<80>, 64, false>;
 template class Real<Integer<128>, 112>;
-}
\ No newline at end of file
+}
index b46cd42..3d9b7cd 100644 (file)
@@ -387,11 +387,12 @@ private:
   Word word_{};  // an Integer<>
 };
 
-extern template class Real<Integer<16>, 11>;
-extern template class Real<Integer<32>, 24>;
-extern template class Real<Integer<64>, 53>;
+extern template class Real<Integer<16>, 11>;  // IEEE half format
+extern template class Real<Integer<16>, 8>;  // the "other" half format
+extern template class Real<Integer<32>, 24>;  // IEEE single
+extern template class Real<Integer<64>, 53>;  // IEEE double
 extern template class Real<Integer<80>, 64, false>;  // 80387 extended precision
-extern template class Real<Integer<128>, 112>;
+extern template class Real<Integer<128>, 112>;  // IEEE quad
 // N.B. No "double-double" support.
 }
 #endif  // FORTRAN_EVALUATE_REAL_H_
index be098f0..1cd148f 100644 (file)
@@ -80,6 +80,7 @@ public:
   using Scalar = value::Integer<8 * KIND>;
 };
 
+// REAL(KIND=2) is IEEE half-precision (16 bits)
 template<>
 class Type<TypeCategory::Real, 2> : public TypeBase<TypeCategory::Real, 2> {
 public:
@@ -87,6 +88,16 @@ public:
       value::Real<typename Type<TypeCategory::Integer, 2>::Scalar, 11>;
 };
 
+// REAL(KIND=3) identifies the "other" half-precision format, which is
+// basically REAL(4) without its least-order 16 fraction bits.
+template<>
+class Type<TypeCategory::Real, 3> : public TypeBase<TypeCategory::Real, 3> {
+public:
+  using Scalar =
+      value::Real<typename Type<TypeCategory::Integer, 2>::Scalar, 8>;
+};
+
+// REAL(KIND=4) is IEEE-754 single precision (32 bits)
 template<>
 class Type<TypeCategory::Real, 4> : public TypeBase<TypeCategory::Real, 4> {
 public:
@@ -94,6 +105,7 @@ public:
       value::Real<typename Type<TypeCategory::Integer, 4>::Scalar, 24>;
 };
 
+// REAL(KIND=8) is IEEE double precision (64 bits)
 template<>
 class Type<TypeCategory::Real, 8> : public TypeBase<TypeCategory::Real, 8> {
 public:
@@ -101,12 +113,14 @@ public:
       value::Real<typename Type<TypeCategory::Integer, 8>::Scalar, 53>;
 };
 
+// REAL(KIND=10) is x87 FPU extended precision (80 bits, all explicit)
 template<>
 class Type<TypeCategory::Real, 10> : public TypeBase<TypeCategory::Real, 10> {
 public:
   using Scalar = value::Real<value::Integer<80>, 64, false>;
 };
 
+// REAL(KIND=16) is IEEE quad precision (128 bits)
 template<>
 class Type<TypeCategory::Real, 16> : public TypeBase<TypeCategory::Real, 16> {
 public:
@@ -177,7 +191,8 @@ static constexpr bool IsValidKindOfIntrinsicType(
     return kind == 1 || kind == 2 || kind == 4 || kind == 8 || kind == 16;
   case TypeCategory::Real:
   case TypeCategory::Complex:
-    return kind == 2 || kind == 4 || kind == 8 || kind == 10 || kind == 16;
+    return kind == 2 || kind == 3 || kind == 4 || kind == 8 || kind == 10 ||
+        kind == 16;
   case TypeCategory::Character: return kind == 1 || kind == 2 || kind == 4;
   case TypeCategory::Logical:
     return kind == 1 || kind == 2 || kind == 4 || kind == 8;
@@ -198,7 +213,7 @@ using CategoryTypesHelper =
     common::CombineTuples<CategoryKindTuple<CATEGORY, KINDS>...>;
 
 template<TypeCategory CATEGORY>
-using CategoryTypes = CategoryTypesHelper<CATEGORY, 1, 2, 4, 8, 10, 16, 32>;
+using CategoryTypes = CategoryTypesHelper<CATEGORY, 1, 2, 3, 4, 8, 10, 16, 32>;
 
 using IntegerTypes = CategoryTypes<TypeCategory::Integer>;
 using RealTypes = CategoryTypes<TypeCategory::Real>;
@@ -274,12 +289,14 @@ struct SomeType {};
   PREFIX<Type<TypeCategory::Integer, 16>>;
 #define FOR_EACH_REAL_KIND(PREFIX) \
   PREFIX<Type<TypeCategory::Real, 2>>; \
+  PREFIX<Type<TypeCategory::Real, 3>>; \
   PREFIX<Type<TypeCategory::Real, 4>>; \
   PREFIX<Type<TypeCategory::Real, 8>>; \
   PREFIX<Type<TypeCategory::Real, 10>>; \
   PREFIX<Type<TypeCategory::Real, 16>>;
 #define FOR_EACH_COMPLEX_KIND(PREFIX) \
   PREFIX<Type<TypeCategory::Complex, 2>>; \
+  PREFIX<Type<TypeCategory::Complex, 3>>; \
   PREFIX<Type<TypeCategory::Complex, 4>>; \
   PREFIX<Type<TypeCategory::Complex, 8>>; \
   PREFIX<Type<TypeCategory::Complex, 10>>; \
index 9a11a5e..e7953aa 100644 (file)
@@ -14,6 +14,7 @@
 
 
 add_library(FortranSemantics
+  assignment.cc
   attr.cc
   canonicalize-do.cc
   check-do-concurrent.cc
diff --git a/flang/lib/semantics/assignment.cc b/flang/lib/semantics/assignment.cc
new file mode 100644 (file)
index 0000000..75b52b5
--- /dev/null
@@ -0,0 +1,80 @@
+// 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.
+
+#include "assignment.h"
+#include "expression.h"
+#include "semantics.h"
+#include "symbol.h"
+#include "../common/idioms.h"
+#include "../evaluate/expression.h"
+#include "../parser/parse-tree-visitor.h"
+#include "../parser/parse-tree.h"
+
+using namespace Fortran::parser::literals;
+
+namespace Fortran::semantics {
+
+template<typename A>
+void AnalyzeExecutableStmt(SemanticsContext &, const parser::Statement<A> &) {}
+template<>
+void AnalyzeExecutableStmt(SemanticsContext &context,
+    const parser::Statement<parser::AssignmentStmt> &stmt) {}
+template<>
+void AnalyzeExecutableStmt(SemanticsContext &context,
+    const parser::Statement<parser::PointerAssignmentStmt> &stmt) {}
+template<>
+void AnalyzeExecutableStmt(SemanticsContext &context,
+    const parser::Statement<parser::WhereStmt> &stmt) {}
+template<>
+void AnalyzeExecutableStmt(SemanticsContext &context,
+    const parser::Statement<parser::ForallStmt> &stmt) {}
+
+void AnalyzeAssignment(SemanticsContext &context,
+    const parser::Statement<parser::AssignmentStmt> &stmt) {
+  AnalyzeExecutableStmt(context, stmt);
+}
+void AnalyzeAssignment(SemanticsContext &context,
+    const parser::Statement<parser::PointerAssignmentStmt> &stmt) {
+  AnalyzeExecutableStmt(context, stmt);
+}
+void AnalyzeAssignment(SemanticsContext &context,
+    const parser::Statement<parser::WhereStmt> &stmt) {
+  AnalyzeExecutableStmt(context, stmt);
+}
+void AnalyzeAssignment(SemanticsContext &context,
+    const parser::Statement<parser::ForallStmt> &stmt) {
+  AnalyzeExecutableStmt(context, stmt);
+}
+
+class Mutator {
+public:
+  Mutator(SemanticsContext &context) : context_{context} {}
+
+  template<typename A> bool Pre(A &) { return true /* visit children */; }
+  template<typename A> void Post(A &) {}
+
+  bool Pre(parser::Statement<parser::AssignmentStmt> &stmt) {
+    AnalyzeAssignment(context_, stmt);
+    return false;
+  }
+
+private:
+  SemanticsContext &context_;
+};
+
+void AnalyzeAssignments(parser::Program &program, SemanticsContext &context) {
+  Mutator mutator{context};
+  parser::Walk(program, mutator);
+}
+}
diff --git a/flang/lib/semantics/assignment.h b/flang/lib/semantics/assignment.h
new file mode 100644 (file)
index 0000000..2e9d179
--- /dev/null
@@ -0,0 +1,43 @@
+// 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.
+
+#ifndef FORTRAN_SEMANTICS_ASSIGNMENT_H_
+#define FORTRAN_SEMANTICS_ASSIGNMENT_H_
+
+namespace Fortran::parser {
+template<typename> struct Statement;
+struct AssignmentStmt;
+struct ForallStmt;
+struct PointerAssignmentStmt;
+struct Program;
+struct WhereStmt;
+}
+
+namespace Fortran::semantics {
+class SemanticsContext;
+
+// Semantic analysis of an assignment statement or WHERE/FORALL construct.
+void AnalyzeAssignment(
+    SemanticsContext &, const parser::Statement<parser::AssignmentStmt> &);
+void AnalyzeAssignment(SemanticsContext &,
+    const parser::Statement<parser::PointerAssignmentStmt> &);
+void AnalyzeAssignment(
+    SemanticsContext &, const parser::Statement<parser::WhereStmt> &);
+void AnalyzeAssignment(
+    SemanticsContext &, const parser::Statement<parser::ForallStmt> &);
+
+// Semantic analysis of all assignment statements and related constructs.
+void AnalyzeAssignments(parser::Program &, SemanticsContext &);
+}
+#endif  // FORTRAN_SEMANTICS_ASSIGNMENT_H_
index 69d18cf..fe46cfb 100644 (file)
 
 using namespace Fortran::parser::literals;
 
+// Typedef for optional generic expressions
+using MaybeExpr =
+    std::optional<Fortran::evaluate::Expr<Fortran::evaluate::SomeType>>;
+
 // Much of the code that implements semantic analysis of expressions is
 // tightly coupled with their typed representations in lib/evaluate,
 // and appears here in namespace Fortran::evaluate for convenience.
@@ -38,6 +42,45 @@ using common::TypeCategory;
 
 using MaybeExpr = std::optional<Expr<SomeType>>;
 
+// Constraint checking
+void ExpressionAnalysisContext::CheckConstraints(
+    MaybeExpr &expr, const Constraints *constraints) {
+  if (constraints != nullptr) {
+    CheckConstraints(expr, constraints->inner);
+    if (expr.has_value()) {
+      if (!(this->*constraints->checker)(*expr)) {
+        expr.reset();
+      }
+    }
+  }
+}
+
+bool ExpressionAnalysisContext::ScalarConstraint(Expr<SomeType> &expr) {
+  int rank{expr.Rank()};
+  if (rank == 0) {
+    return true;
+  }
+  Say("expression must be scalar, but has rank %d"_err_en_US, rank);
+  return false;
+}
+
+bool ExpressionAnalysisContext::ConstantConstraint(Expr<SomeType> &expr) {
+  expr = Fold(context.foldingContext(), std::move(expr));
+  if (IsConstant(expr)) {
+    return true;
+  }
+  Say("expression must be constant"_err_en_US);
+  return false;
+}
+
+bool ExpressionAnalysisContext::IntegerConstraint(Expr<SomeType> &expr) {
+  if (std::holds_alternative<Expr<SomeInteger>>(expr.u)) {
+    return true;
+  }
+  Say("expression must be INTEGER"_err_en_US);
+  return false;
+}
+
 // A utility subroutine to repackage optional expressions of various levels
 // of type specificity as fully general MaybeExpr values.
 template<typename A> MaybeExpr AsMaybeExpr(A &&x) {
@@ -114,10 +157,10 @@ struct CallAndArguments {
 // This local class wraps some state and a highly overloaded Analyze()
 // member function that converts parse trees into (usually) generic
 // expressions.
-struct ExprAnalyzer {
-  explicit ExprAnalyzer(semantics::SemanticsContext &ctx) : context{ctx} {}
+struct ExprAnalyzer : public ExpressionAnalysisContext {
+  using ExpressionAnalysisContext::ExpressionAnalysisContext;
 
-  MaybeExpr Analyze(const parser::Expr &);
+  MaybeExpr Analyze(const parser::Expr &, const Constraints * = nullptr);
   MaybeExpr Analyze(const parser::CharLiteralConstantSubstring &);
   MaybeExpr Analyze(const parser::LiteralConstant &);
   MaybeExpr Analyze(const parser::IntLiteralConstant &);
@@ -187,81 +230,39 @@ struct ExprAnalyzer {
 
   std::optional<CallAndArguments> Procedure(
       const parser::ProcedureDesignator &, ActualArguments &);
-
-  template<typename... A> void Say(A... args) {
-    context.foldingContext().messages.Say(std::forward<A>(args)...);
-  }
-  template<typename... A> void Say(const parser::CharBlock &at, A... args) {
-    context.foldingContext().messages.Say(at, std::forward<A>(args)...);
-  }
-
-  semantics::SemanticsContext &context;
 };
-
-// This helper template function handles the Scalar<>, Integer<>, and
-// Constant<> wrappers in the parse tree, as well as default behavior
-// for unions.  (C++ doesn't allow template specialization in
-// a class, so this helper template function must be outside ExprAnalyzer
-// and reflect back into it.)
-template<typename A> MaybeExpr AnalyzeHelper(ExprAnalyzer &ea, const A &x) {
-  if constexpr (UnionTrait<A>) {
-    return AnalyzeHelper(ea, x.u);
-  } else {
-    return ea.Analyze(x);
-  }
 }
 
-template<typename A>
-MaybeExpr AnalyzeHelper(ExprAnalyzer &ea, const parser::Scalar<A> &x) {
-  if (MaybeExpr result{AnalyzeHelper(ea, x.thing)}) {
-    int rank{result->Rank()};
-    if (rank > 0) {
-      ea.Say("expression must be scalar, but has rank %d"_err_en_US, rank);
-    }
-  }
-  return std::nullopt;
-}
-
-template<typename A>
-MaybeExpr AnalyzeHelper(ExprAnalyzer &ea, const parser::Integer<A> &x) {
-  if (auto result{AnalyzeHelper(ea, x.thing)}) {
-    if (std::holds_alternative<Expr<SomeInteger>>(result->u)) {
-      return result;
-    }
-    ea.Say("expression must be INTEGER"_err_en_US);
-  }
-  return std::nullopt;
-}
+namespace Fortran::semantics {
 
-template<typename A>
-MaybeExpr AnalyzeHelper(ExprAnalyzer &ea, const parser::Constant<A> &x) {
-  if (MaybeExpr result{AnalyzeHelper(ea, x.thing)}) {
-    Expr<SomeType> folded{
-        Fold(ea.context.foldingContext(), std::move(*result))};
-    if (IsConstant(folded)) {
-      return {folded};
-    }
-    ea.Say("expression must be constant"_err_en_US);
-  }
-  return std::nullopt;
+MaybeExpr AnalyzeExpr(SemanticsContext &context, const parser::Expr &expr,
+    const evaluate::Constraints *constraints) {
+  evaluate::ExprAnalyzer ea{context};
+  return ea.Analyze(expr, constraints);
 }
 
 template<typename... As>
-MaybeExpr AnalyzeHelper(ExprAnalyzer &ea, const std::variant<As...> &u) {
-  return std::visit([&](const auto &x) { return AnalyzeHelper(ea, x); }, u);
+MaybeExpr AnalyzeExpr(SemanticsContext &context, const std::variant<As...> &u,
+    const evaluate::Constraints *constraints) {
+  return std::visit(
+      [&](const auto &x) { return AnalyzeExpr(context, x, constraints); }, u);
 }
 
 template<typename A>
-MaybeExpr AnalyzeHelper(ExprAnalyzer &ea, const common::Indirection<A> &x) {
-  return AnalyzeHelper(ea, *x);
+MaybeExpr AnalyzeExpr(SemanticsContext &context,
+    const common::Indirection<A> &x, const evaluate::Constraints *constraints) {
+  return AnalyzeExpr(context, *x, constraints);
 }
 
 template<>
-MaybeExpr AnalyzeHelper(ExprAnalyzer &ea, const parser::Designator &d) {
+MaybeExpr AnalyzeExpr(SemanticsContext &context, const parser::Designator &d,
+    const evaluate::Constraints *constraints) {
   // These checks have to be deferred to these "top level" data-refs where
   // we can be sure that there are no following subscripts (yet).
-  if (MaybeExpr result{AnalyzeHelper(ea, d.u)}) {
-    if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(result))}) {
+  if (MaybeExpr result{AnalyzeExpr(context, d.u, constraints)}) {
+    if (std::optional<evaluate::DataRef> dataRef{
+            evaluate::ExtractDataRef(std::move(result))}) {
+      evaluate::ExprAnalyzer ea{context};
       return ea.TopLevelChecks(std::move(*dataRef));
     }
     return result;
@@ -269,21 +270,42 @@ MaybeExpr AnalyzeHelper(ExprAnalyzer &ea, const parser::Designator &d) {
   return std::nullopt;
 }
 
-// Analyze something with source provenance
-template<typename A> MaybeExpr AnalyzeSourced(ExprAnalyzer &ea, const A &x) {
-  if (!x.source.empty()) {
-    auto save{ea.context.foldingContext().messages.SetLocation(x.source)};
-    return AnalyzeHelper(ea, x);
+template<typename A>
+MaybeExpr AnalyzeExpr(SemanticsContext &context, const A &x,
+    const evaluate::Constraints *constraints) {
+  if constexpr (UnionTrait<A>) {
+    return AnalyzeExpr(context, x.u, constraints);
   } else {
-    return AnalyzeHelper(ea, x);
+    evaluate::ExprAnalyzer ea{context};
+    MaybeExpr result{ea.Analyze(x)};
+    ea.CheckConstraints(result, constraints);
+    return result;
   }
 }
+}
+
+namespace Fortran::evaluate {
+
+template<typename A> MaybeExpr AnalyzeHelper(ExprAnalyzer &ea, const A &x) {
+  return semantics::AnalyzeExpr(ea.context, x, nullptr);
+}
 
 // Implementations of ExprAnalyzer::Analyze follow for various parse tree
 // node types.
 
-MaybeExpr ExprAnalyzer::Analyze(const parser::Expr &x) {
-  return AnalyzeSourced(*this, x);
+MaybeExpr ExprAnalyzer::Analyze(
+    const parser::Expr &expr, const Constraints *constraints) {
+  if (!expr.source.empty()) {
+    // Analyze the expression in a specified source position context for better
+    // error reporting.
+    auto save{context.foldingContext().messages.SetLocation(expr.source)};
+    MaybeExpr result{semantics::AnalyzeExpr(context, expr.u, nullptr)};
+    CheckConstraints(result, constraints);
+    return result;
+  }
+  MaybeExpr result{semantics::AnalyzeExpr(context, expr.u, nullptr)};
+  CheckConstraints(result, constraints);
+  return result;
 }
 
 int ExprAnalyzer::Analyze(const std::optional<parser::KindParam> &kindParam,
@@ -1269,47 +1291,9 @@ void ExprAnalyzer::CheckUnsubscriptedComponent(const Component &component) {
 
 namespace Fortran::semantics {
 
-evaluate::MaybeExpr AnalyzeExpr(
-    SemanticsContext &context, const parser::Expr &expr) {
-  return evaluate::ExprAnalyzer{context}.Analyze(expr);
-}
-
-template<typename A>
-evaluate::MaybeExpr AnalyzeWrappedExpr(
-    SemanticsContext &context, const A &expr) {
-  evaluate::ExprAnalyzer ea{context};
-  return evaluate::AnalyzeHelper(ea, expr);
-}
-
-evaluate::MaybeExpr AnalyzeExpr(
-    SemanticsContext &context, const parser::Scalar<parser::Expr> &expr) {
-  return AnalyzeWrappedExpr(context, expr);
-}
-evaluate::MaybeExpr AnalyzeExpr(
-    SemanticsContext &context, const parser::Constant<parser::Expr> &expr) {
-  return AnalyzeWrappedExpr(context, expr);
-}
-evaluate::MaybeExpr AnalyzeExpr(
-    SemanticsContext &context, const parser::Integer<parser::Expr> &expr) {
-  return AnalyzeWrappedExpr(context, expr);
-}
-evaluate::MaybeExpr AnalyzeExpr(SemanticsContext &context,
-    const parser::Scalar<parser::Constant<parser::Expr>> &expr) {
-  return AnalyzeWrappedExpr(context, expr);
-}
-evaluate::MaybeExpr AnalyzeExpr(SemanticsContext &context,
-    const parser::Scalar<parser::Integer<parser::Expr>> &expr) {
-  return AnalyzeWrappedExpr(context, expr);
-}
-evaluate::MaybeExpr AnalyzeExpr(SemanticsContext &context,
-    const parser::Integer<parser::Constant<parser::Expr>> &expr) {
-  return AnalyzeWrappedExpr(context, expr);
-}
-evaluate::MaybeExpr AnalyzeExpr(SemanticsContext &context,
-    const parser::Scalar<parser::Integer<parser::Constant<parser::Expr>>>
-        &expr) {
-  return AnalyzeWrappedExpr(context, expr);
-}
+template std::optional<evaluate::Expr<evaluate::SomeType>> AnalyzeExpr(
+    SemanticsContext &, const parser::Expr &,
+    const evaluate::Constraints *c = nullptr);
 
 class Mutator {
 public:
index 2ab9f9a..29aaac4 100644 (file)
 #ifndef FORTRAN_SEMANTICS_EXPRESSION_H_
 #define FORTRAN_SEMANTICS_EXPRESSION_H_
 
+#include "semantics.h"
 #include "../evaluate/expression.h"
 #include "../evaluate/type.h"
 #include <optional>
+#include <variant>
 
 namespace Fortran::parser {
 struct Expr;
@@ -27,30 +29,77 @@ template<typename> struct Integer;
 template<typename> struct Constant;
 }
 
+namespace Fortran::evaluate {
+struct Constraints;
+struct ExpressionAnalysisContext {
+  using ConstraintChecker = bool (ExpressionAnalysisContext::*)(
+      Expr<SomeType> &);
+
+  ExpressionAnalysisContext(semantics::SemanticsContext &ctx) : context{ctx} {}
+
+  template<typename... A> void Say(A... args) {
+    context.foldingContext().messages.Say(std::forward<A>(args)...);
+  }
+
+  void CheckConstraints(std::optional<Expr<SomeType>> &, const Constraints *);
+  bool ScalarConstraint(Expr<SomeType> &);
+  bool ConstantConstraint(Expr<SomeType> &);
+  bool IntegerConstraint(Expr<SomeType> &);
+
+  semantics::SemanticsContext &context;
+};
+
+// Constraint checking (e.g., for Scalar<> expressions) is implemented by
+// passing a pointer to one of these partial closures along to AnalyzeExpr.
+// The constraint can then be checked and errors reported with precise
+// source program location information.
+struct Constraints {
+  ExpressionAnalysisContext::ConstraintChecker checker;
+  const Constraints *inner{nullptr};
+};
+}
+
 namespace Fortran::semantics {
 
 class SemanticsContext;
 
 // Semantic analysis of one expression.
-std::optional<evaluate::Expr<evaluate::SomeType>> AnalyzeExpr(
-    SemanticsContext &, const parser::Expr &);
 
+template<typename PARSED>
 std::optional<evaluate::Expr<evaluate::SomeType>> AnalyzeExpr(
-    SemanticsContext &, const parser::Scalar<parser::Expr> &);
-std::optional<evaluate::Expr<evaluate::SomeType>> AnalyzeExpr(
-    SemanticsContext &, const parser::Constant<parser::Expr> &);
-std::optional<evaluate::Expr<evaluate::SomeType>> AnalyzeExpr(
-    SemanticsContext &, const parser::Integer<parser::Expr> &);
-std::optional<evaluate::Expr<evaluate::SomeType>> AnalyzeExpr(
-    SemanticsContext &, const parser::Scalar<parser::Constant<parser::Expr>> &);
+    SemanticsContext &, const PARSED &,
+    const evaluate::Constraints * = nullptr);
+
+extern template std::optional<evaluate::Expr<evaluate::SomeType>> AnalyzeExpr(
+    SemanticsContext &, const parser::Expr &,
+    const evaluate::Constraints *c = nullptr);
+
+template<typename A>
 std::optional<evaluate::Expr<evaluate::SomeType>> AnalyzeExpr(
-    SemanticsContext &, const parser::Scalar<parser::Integer<parser::Expr>> &);
+    SemanticsContext &context, const parser::Scalar<A> &expr,
+    const evaluate::Constraints *constraints = nullptr) {
+  evaluate::Constraints newConstraints{
+      &evaluate::ExpressionAnalysisContext::ScalarConstraint, constraints};
+  return AnalyzeExpr(context, expr.thing, &newConstraints);
+}
+
+template<typename A>
 std::optional<evaluate::Expr<evaluate::SomeType>> AnalyzeExpr(
-    SemanticsContext &,
-    const parser::Integer<parser::Constant<parser::Expr>> &);
+    SemanticsContext &context, const parser::Constant<A> &expr,
+    const evaluate::Constraints *constraints = nullptr) {
+  evaluate::Constraints newConstraints{
+      &evaluate::ExpressionAnalysisContext::ConstantConstraint, constraints};
+  return AnalyzeExpr(context, expr.thing, &newConstraints);
+}
+
+template<typename A>
 std::optional<evaluate::Expr<evaluate::SomeType>> AnalyzeExpr(
-    SemanticsContext &,
-    const parser::Scalar<parser::Integer<parser::Constant<parser::Expr>>> &);
+    SemanticsContext &context, const parser::Integer<A> &expr,
+    const evaluate::Constraints *constraints = nullptr) {
+  evaluate::Constraints newConstraints{
+      &evaluate::ExpressionAnalysisContext::IntegerConstraint, constraints};
+  return AnalyzeExpr(context, expr.thing, &newConstraints);
+}
 
 // Semantic analysis of all expressions in a parse tree, which is
 // decorated with typed representations for top-level expressions.
index 117d39c..3708961 100644 (file)
@@ -16,6 +16,7 @@
 #include "canonicalize-do.h"
 #include "check-do-concurrent.h"
 #include "default-kinds.h"
+#include "expression.h"
 #include "mod-file.h"
 #include "resolve-labels.h"
 #include "resolve-names.h"
index d64a0df..7cbd49c 100644 (file)
@@ -15,7 +15,6 @@
 #ifndef FORTRAN_SEMANTICS_SEMANTICS_H_
 #define FORTRAN_SEMANTICS_SEMANTICS_H_
 
-#include "expression.h"
 #include "scope.h"
 #include "../evaluate/common.h"
 #include "../evaluate/intrinsics.h"
index cfb14fb..9f978c8 100644 (file)
@@ -13,6 +13,7 @@
 // limitations under the License.
 
 #include "type.h"
+#include "expression.h"
 #include "scope.h"
 #include "semantics.h"
 #include "symbol.h"
index de2a04a..ddcc980 100644 (file)
@@ -25,6 +25,7 @@ using namespace Fortran::evaluate;
 using namespace Fortran::common;
 
 using Real2 = Scalar<Type<TypeCategory::Real, 2>>;
+using Real3 = Scalar<Type<TypeCategory::Real, 3>>;
 using Real4 = Scalar<Type<TypeCategory::Real, 4>>;
 using Real8 = Scalar<Type<TypeCategory::Real, 8>>;
 using Real10 = Scalar<Type<TypeCategory::Real, 10>>;
@@ -514,6 +515,7 @@ void subsetTests(int pass, Rounding rounding, std::uint32_t opds) {
 
 void roundTest(int rm, Rounding rounding, std::uint32_t opds) {
   basicTests<Real2>(rm, rounding);
+  basicTests<Real3>(rm, rounding);
   basicTests<Real4>(rm, rounding);
   basicTests<Real8>(rm, rounding);
   basicTests<Real10>(rm, rounding);