[flang] DATA stmt processing (part 3/4): Remaining prep work

Rolls up small changes across the frontend to prepare for the large
forthcoming patch (part 4/4) that completes DATA statement processing
via conversion to initializers.

Reviewed By: PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D82137

Author: klausler

flang/documentation/FortranForCProgrammers.md

@@ -91,7 +91,7 @@ byte sizes of the data.
 (For `COMPLEX`, the kind type parameter value is the byte size of one of the
 two `REAL` components, or half of the total size.)
 The legacy `DOUBLE PRECISION` intrinsic type is an alias for a kind of `REAL`
-that should be bigger than the default `REAL`.
+that should be more precise, and bigger, than the default `REAL`.
 
 `COMPLEX` is a simple structure that comprises two `REAL` components.
 
@@ -363,3 +363,9 @@ result; e.g., if there is a `PRINT` statement in function `F`, it
 may or may not be executed by the assignment statement `X=0*F()`.
 (Well, it probably will be, in practice, but compilers always reserve
 the right to optimize better.)
+
+Unless they have an explicit suffix (`1.0_8`, `2.0_8`) or a `D`
+exponent (`3.0D0`), real literal constants in Fortran have the
+default `REAL` type -- *not* `double` as in the case in C and C++.
+If you're not careful, you can lose precision at compilation time
+from your constant values and never know it.

flang/include/flang/Common/interval.h

@@ -31,12 +31,26 @@ template <typename A> class Interval {
   constexpr Interval &operator=(const Interval &) = default;
   constexpr Interval &operator=(Interval &&) = default;
 
+  constexpr bool operator<(const Interval &that) const {
+    return start_ < that.start_ ||
+        (start_ == that.start_ && size_ < that.size_);
+  }
+  constexpr bool operator<=(const Interval &that) const {
+    return start_ < that.start_ ||
+        (start_ == that.start_ && size_ <= that.size_);
+  }
   constexpr bool operator==(const Interval &that) const {
     return start_ == that.start_ && size_ == that.size_;
   }
   constexpr bool operator!=(const Interval &that) const {
     return !(*this == that);
   }
+  constexpr bool operator>=(const Interval &that) const {
+    return !(*this < that);
+  }
+  constexpr bool operator>(const Interval &that) const {
+    return !(*this <= that);
+  }
 
   constexpr const A &start() const { return start_; }
   constexpr std::size_t size() const { return size_; }

flang/include/flang/Evaluate/characteristics.h

@@ -278,7 +278,7 @@ struct Procedure {
       const ProcedureRef &, const IntrinsicProcTable &);
 
   // At most one of these will return true.
-  // For "EXTERNAL P" with no calls to P, both will be false.
+  // For "EXTERNAL P" with no type for or calls to P, both will be false.
   bool IsFunction() const { return functionResult.has_value(); }
   bool IsSubroutine() const { return attrs.test(Attr::Subroutine); }
 

flang/include/flang/Evaluate/check-expression.h

@@ -33,12 +33,19 @@ template <typename A> bool IsConstantExpr(const A &);
 extern template bool IsConstantExpr(const Expr<SomeType> &);
 extern template bool IsConstantExpr(const Expr<SomeInteger> &);
 extern template bool IsConstantExpr(const Expr<SubscriptInteger> &);
+extern template bool IsConstantExpr(const StructureConstructor &);
 
 // Checks whether an expression is an object designator with
 // constant addressing and no vector-valued subscript.
+// If a non-null ContextualMessages pointer is passed, an error message
+// will be generated if and only if the result of the function is false.
 bool IsInitialDataTarget(
     const Expr<SomeType> &, parser::ContextualMessages * = nullptr);
 
+bool IsInitialProcedureTarget(const Symbol &);
+bool IsInitialProcedureTarget(const ProcedureDesignator &);
+bool IsInitialProcedureTarget(const Expr<SomeType> &);
+
 // Check whether an expression is a specification expression
 // (10.1.11(2), C1010).  Constant expressions are always valid
 // specification expressions.

flang/include/flang/Evaluate/constant.h

@@ -32,9 +32,9 @@ using SymbolRef = common::Reference<const Symbol>;
 // Wraps a constant value in a class templated by its resolved type.
 // This Constant<> template class should be instantiated only for
 // concrete intrinsic types and SomeDerived.  There is no instance
-// Constant<Expr<SomeType>> since there is no way to constrain each
+// Constant<SomeType> since there is no way to constrain each
 // element of its array to hold the same type.  To represent a generic
-// constants, use a generic expression like Expr<SomeInteger> &
+// constant, use a generic expression like Expr<SomeInteger> or
 // Expr<SomeType>) to wrap the appropriate instantiation of Constant<>.
 
 template <typename> class Constant;
@@ -50,7 +50,7 @@ std::size_t TotalElementCount(const ConstantSubscripts &);
 
 // Validate dimension re-ordering like ORDER in RESHAPE.
 // On success, return a vector that can be used as dimOrder in
-// ConstantBound::IncrementSubscripts.
+// ConstantBound::IncrementSubscripts().
 std::optional<std::vector<int>> ValidateDimensionOrder(
     int rank, const std::vector<int> &order);
 
@@ -71,8 +71,8 @@ class ConstantBounds {
   // If no optional dimension order argument is passed, increments a vector of
   // subscripts in Fortran array order (first dimension varying most quickly).
   // Otherwise, increments the vector of subscripts according to the given
-  // dimension order (dimension dimOrder[0] varying most quickly. Dimensions
-  // indexing is zero based here.) Returns false when last element was visited.
+  // dimension order (dimension dimOrder[0] varying most quickly; dimension
+  // indexing is zero based here). Returns false when last element was visited.
   bool IncrementSubscripts(
       ConstantSubscripts &, const std::vector<int> *dimOrder = nullptr) const;
 
@@ -158,7 +158,8 @@ class Constant<Type<TypeCategory::Character, KIND>> : public ConstantBounds {
   CLASS_BOILERPLATE(Constant)
   explicit Constant(const Scalar<Result> &);
   explicit Constant(Scalar<Result> &&);
-  Constant(ConstantSubscript, std::vector<Element> &&, ConstantSubscripts &&);
+  Constant(
+      ConstantSubscript length, std::vector<Element> &&, ConstantSubscripts &&);
   ~Constant();
 
   bool operator==(const Constant &that) const {
@@ -191,8 +192,6 @@ class Constant<Type<TypeCategory::Character, KIND>> : public ConstantBounds {
 private:
   Scalar<Result> values_; // one contiguous string
   ConstantSubscript length_;
-  ConstantSubscripts shape_;
-  ConstantSubscripts lbounds_;
 };
 
 class StructureConstructor;

flang/include/flang/Evaluate/fold.h

@@ -10,7 +10,7 @@
 #define FORTRAN_EVALUATE_FOLD_H_
 
 // Implements expression tree rewriting, particularly constant expression
-// evaluation.
+// and designator reference evaluation.
 
 #include "common.h"
 #include "constant.h"

flang/include/flang/Evaluate/tools.h

@@ -913,6 +913,7 @@ bool IsDummy(const Symbol &);
 const Symbol *GetAssociationRoot(const Symbol &);
 const Symbol *FindCommonBlockContaining(const Symbol &);
 int CountLenParameters(const DerivedTypeSpec &);
+int CountNonConstantLenParameters(const DerivedTypeSpec &);
 const Symbol &GetUsedModule(const UseDetails &);
 
 } // namespace Fortran::semantics

flang/include/flang/Parser/parse-tree.h

@@ -1400,15 +1400,16 @@ using TypedExpr = std::unique_ptr<evaluate::GenericExprWrapper,
 // R845 data-stmt-constant ->
 //        scalar-constant | scalar-constant-subobject |
 //        signed-int-literal-constant | signed-real-literal-constant |
-//        null-init | initial-data-target | structure-constructor
+//        null-init | initial-data-target |
+//        constant-structure-constructor    <- added "constant-"
 struct DataStmtConstant {
   UNION_CLASS_BOILERPLATE(DataStmtConstant);
   CharBlock source;
   mutable TypedExpr typedExpr;
   std::variant<Scalar<ConstantValue>, Scalar<ConstantSubobject>,
       SignedIntLiteralConstant, SignedRealLiteralConstant,
       SignedComplexLiteralConstant, NullInit, InitialDataTarget,
-      StructureConstructor>
+      Constant<StructureConstructor>>
       u;
 };
 
@@ -1424,6 +1425,7 @@ struct DataStmtRepeat {
 // R843 data-stmt-value -> [data-stmt-repeat *] data-stmt-constant
 struct DataStmtValue {
   TUPLE_CLASS_BOILERPLATE(DataStmtValue);
+  mutable std::size_t repetitions{1}; // replaced during semantics
   std::tuple<std::optional<DataStmtRepeat>, DataStmtConstant> t;
 };
 

flang/include/flang/Parser/tools.h

@@ -28,6 +28,19 @@ const Name &GetLastName(const FunctionReference &);
 const Name &GetLastName(const Variable &);
 const Name &GetLastName(const AllocateObject &);
 
+// GetFirstName() isolates and returns a reference to the leftmost Name
+// in a variable.
+const Name &GetFirstName(const Name &);
+const Name &GetFirstName(const StructureComponent &);
+const Name &GetFirstName(const DataRef &);
+const Name &GetFirstName(const Substring &);
+const Name &GetFirstName(const Designator &);
+const Name &GetFirstName(const ProcComponentRef &);
+const Name &GetFirstName(const ProcedureDesignator &);
+const Name &GetFirstName(const Call &);
+const Name &GetFirstName(const FunctionReference &);
+const Name &GetFirstName(const Variable &);
+
 // When a parse tree node is an instance of a specific type wrapped in
 // layers of packaging, return a pointer to that object.
 // Implemented with mutually recursive template functions that are

flang/include/flang/Semantics/expression.h

@@ -131,8 +131,11 @@ class ExpressionAnalyzer {
   bool CheckIntrinsicSize(TypeCategory, std::int64_t size);
 
   // Manage a set of active implied DO loops.
-  bool AddImpliedDo(parser::CharBlock, int);
+  bool AddImpliedDo(parser::CharBlock, int kind);
   void RemoveImpliedDo(parser::CharBlock);
+
+  // When the argument is the name of an active implied DO index, returns
+  // its INTEGER kind type parameter.
   std::optional<int> IsImpliedDo(parser::CharBlock) const;
 
   Expr<SubscriptInteger> AnalyzeKindSelector(common::TypeCategory category,
@@ -141,7 +144,7 @@ class ExpressionAnalyzer {
   MaybeExpr Analyze(const parser::Expr &);
   MaybeExpr Analyze(const parser::Variable &);
   MaybeExpr Analyze(const parser::Designator &);
-  MaybeExpr Analyze(const parser::DataStmtConstant &);
+  MaybeExpr Analyze(const parser::DataStmtValue &);
 
   template <typename A> MaybeExpr Analyze(const common::Indirection<A> &x) {
     return Analyze(x.value());
@@ -241,6 +244,7 @@ class ExpressionAnalyzer {
   MaybeExpr Analyze(const parser::BOZLiteralConstant &);
   MaybeExpr Analyze(const parser::NamedConstant &);
   MaybeExpr Analyze(const parser::NullInit &);
+  MaybeExpr Analyze(const parser::DataStmtConstant &);
   MaybeExpr Analyze(const parser::Substring &);
   MaybeExpr Analyze(const parser::ArrayElement &);
   MaybeExpr Analyze(const parser::CoindexedNamedObject &);
@@ -420,17 +424,19 @@ class ExprChecker {
   bool Walk(const parser::Program &);
 
   bool Pre(const parser::Expr &x) {
-    AnalyzeExpr(context_, x);
+    exprAnalyzer_.Analyze(x);
     return false;
   }
   bool Pre(const parser::Variable &x) {
-    AnalyzeExpr(context_, x);
+    exprAnalyzer_.Analyze(x);
     return false;
   }
-  bool Pre(const parser::DataStmtConstant &x) {
-    AnalyzeExpr(context_, x);
+  bool Pre(const parser::DataStmtValue &x) {
+    exprAnalyzer_.Analyze(x);
     return false;
   }
+  bool Pre(const parser::DataImpliedDo &);
+
   bool Pre(const parser::CallStmt &x) {
     AnalyzeCallStmt(context_, x);
     return false;
@@ -445,28 +451,29 @@ class ExprChecker {
   }
 
   template <typename A> bool Pre(const parser::Scalar<A> &x) {
-    AnalyzeExpr(context_, x);
+    exprAnalyzer_.Analyze(x);
     return false;
   }
   template <typename A> bool Pre(const parser::Constant<A> &x) {
-    AnalyzeExpr(context_, x);
+    exprAnalyzer_.Analyze(x);
     return false;
   }
   template <typename A> bool Pre(const parser::Integer<A> &x) {
-    AnalyzeExpr(context_, x);
+    exprAnalyzer_.Analyze(x);
     return false;
   }
   template <typename A> bool Pre(const parser::Logical<A> &x) {
-    AnalyzeExpr(context_, x);
+    exprAnalyzer_.Analyze(x);
     return false;
   }
   template <typename A> bool Pre(const parser::DefaultChar<A> &x) {
-    AnalyzeExpr(context_, x);
+    exprAnalyzer_.Analyze(x);
     return false;
   }
 
 private:
   SemanticsContext &context_;
+  evaluate::ExpressionAnalyzer exprAnalyzer_{context_};
 };
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_EXPRESSION_H_