[flang] Change parse tree to allow DO loop over REAL

It is a common extension to allow DO loops with REAL variable and
bounds. The parse tree currently parses those with the variable
as `scalar-int-variable-name` and the bounds as `scalar-int-expr`.
That causes the INTEGER constraint to be enforced automatically.

Change the grammar and parse tree to treat them as `scalar-variable-name`
and `scalar-expr`. This allows the name and expression to be REAL,
but we will have to verify that they aren't any other type (in a future
change).

To accomplish this, add a template parameter to `LoopBounds` for the type
of the variable name (always `Scalar<Name>` or `Scalar<Integer<Name>>`).
We sometimes need names for the instantiations of `LoopBounds` so add
type aliases like `LoopControl::Bounds` for each one.

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

flang/lib/FIR/afforestation.cc

@@ -974,17 +974,15 @@ public:
     if (ctrl.has_value()) {
       std::visit(
           common::visitors{
-              [&](const parser::LoopBounds<parser::ScalarIntExpr> &bounds) {
-                auto name{builder_->CreateAddr(
-                    ToExpression(bounds.name.thing.thing))};
+              [&](const parser::LoopControl::Bounds &bounds) {
+                auto name{
+                    builder_->CreateAddr(ToExpression(bounds.name.thing))};
                 // evaluate e1, e2 [, e3] ...
-                auto *e1{
-                    builder_->CreateExpr(ExprRef(bounds.lower.thing.thing))};
-                auto *e2{
-                    builder_->CreateExpr(ExprRef(bounds.upper.thing.thing))};
+                auto *e1{builder_->CreateExpr(ExprRef(bounds.lower.thing))};
+                auto *e2{builder_->CreateExpr(ExprRef(bounds.upper.thing))};
                 Statement *e3;
                 if (bounds.step.has_value()) {
-                  e3 = builder_->CreateExpr(ExprRef(bounds.step->thing.thing));
+                  e3 = builder_->CreateExpr(ExprRef(bounds.step->thing));
                 } else {
                   e3 = builder_->CreateExpr(CreateConstant(1));
                 }
@@ -1025,8 +1023,7 @@ public:
   void FinishConstruct(const parser::NonLabelDoStmt *stmt) {
     auto &ctrl{std::get<std::optional<parser::LoopControl>>(stmt->t)};
     if (ctrl.has_value()) {
-      using A = parser::LoopBounds<parser::ScalarIntExpr>;
-      if (std::holds_alternative<A>(ctrl->u)) {
+      if (std::holds_alternative<parser::LoopControl::Bounds>(ctrl->u)) {
         PopDoContext(stmt);
       }
     }
@@ -1037,7 +1034,7 @@ public:
     if (loopCtrl.has_value()) {
       return std::visit(
           common::visitors{
-              [&](const parser::LoopBounds<parser::ScalarIntExpr> &) {
+              [&](const parser::LoopControl::Bounds &) {
                 return doMap_.find(stmt)->second.condition;
               },
               [&](const parser::ScalarLogicalExpr &sle) {

flang/lib/parser/dump-parse-tree.h

@@ -380,8 +380,9 @@ public:
   NODE(parser, LockStmt)
   NODE(parser::LockStmt, LockStat)
   NODE(parser, LogicalLiteralConstant)
-  NODE_NAME(parser::LoopBounds<parser::ScalarIntConstantExpr>, "LoopBounds")
-  NODE_NAME(parser::LoopBounds<parser::ScalarIntExpr>, "LoopBounds")
+  NODE_NAME(parser::LoopControl::Bounds, "LoopBounds")
+  NODE_NAME(parser::AcImpliedDoControl::Bounds, "LoopBounds")
+  NODE_NAME(parser::DataImpliedDo::Bounds, "LoopBounds")
   NODE(parser, LoopControl)
   NODE(parser::LoopControl, Concurrent)
   NODE(parser, MainProgram)

flang/lib/parser/grammar.h

@@ -259,6 +259,7 @@ constexpr auto scalarIntExpr{scalar(intExpr)};
 
 // R1029 constant-expr -> expr
 constexpr auto constantExpr{constant(indirect(expr))};
+constexpr auto scalarExpr{scalar(indirect(expr))};
 
 // R1030 default-char-constant-expr -> default-char-expr
 constexpr auto scalarDefaultCharConstantExpr{scalar(defaultChar(constantExpr))};
@@ -959,9 +960,16 @@ TYPE_PARSER(construct<BOZLiteralConstant>(BOZLiteral{}))
 // R1124 do-variable -> scalar-int-variable-name
 constexpr auto doVariable{scalar(integer(name))};
 
+// NOTE: In loop-control we allow REAL name and bounds too.
+// This means parse them without the integer constraint and check later.
 template<typename PA> inline constexpr auto loopBounds(const PA &p) {
-  return construct<LoopBounds<typename PA::resultType>>(
-      doVariable / "=", p / ",", p, maybe("," >> p));
+  if constexpr (std::is_same_v<typename PA::resultType, ScalarExpr>) {
+    return construct<LoopBounds<ScalarName, typename PA::resultType>>(
+        scalar(name) / "=", p / ",", p, maybe("," >> p));
+  } else {
+    return construct<LoopBounds<DoVariable, typename PA::resultType>>(
+        doVariable / "=", p / ",", p, maybe("," >> p));
+  }
 }
 
 // R769 array-constructor -> (/ ac-spec /) | lbracket ac-spec rbracket
@@ -2162,7 +2170,7 @@ TYPE_PARSER(construct<LocalitySpec>(construct<LocalitySpec::Local>(
 // R1129 concurrent-locality -> [locality-spec]...
 TYPE_CONTEXT_PARSER("loop control"_en_US,
     maybe(","_tok) >>
-        (construct<LoopControl>(loopBounds(scalarIntExpr)) ||
+        (construct<LoopControl>(loopBounds(scalarExpr)) ||
             construct<LoopControl>(
                 "WHILE" >> parenthesized(scalarLogicalExpr)) ||
             construct<LoopControl>(construct<LoopControl::Concurrent>(

flang/lib/parser/parse-tree-visitor.h

@@ -450,7 +450,8 @@ template<typename M> void Walk(IntrinsicTypeSpec::Real &x, M &mutator) {
     mutator.Post(x);
   }
 }
-template<typename T, typename V> void Walk(const LoopBounds<T> &x, V &visitor) {
+template<typename A, typename B, typename V>
+void Walk(const LoopBounds<A, B> &x, V &visitor) {
   if (visitor.Pre(x)) {
     Walk(x.name, visitor);
     Walk(x.lower, visitor);
@@ -459,7 +460,8 @@ template<typename T, typename V> void Walk(const LoopBounds<T> &x, V &visitor) {
     visitor.Post(x);
   }
 }
-template<typename T, typename M> void Walk(LoopBounds<T> &x, M &mutator) {
+template<typename A, typename B, typename M>
+void Walk(LoopBounds<A, B> &x, M &mutator) {
   if (mutator.Pre(x)) {
     Walk(x.name, mutator);
     Walk(x.lower, mutator);

flang/lib/parser/parse-tree.h

@@ -1208,24 +1208,28 @@ WRAPPER_CLASS(ArrayConstructor, AcSpec);
 // R1124 do-variable -> scalar-int-variable-name
 using DoVariable = Scalar<Integer<Name>>;
 
-template<typename A> struct LoopBounds {
+template<typename A, typename B> struct LoopBounds {
   LoopBounds(LoopBounds &&that) = default;
-  LoopBounds(DoVariable &&n, A &&a, A &&z, std::optional<A> &&s)
+  LoopBounds(A &&n, B &&a, B &&z, std::optional<B> &&s)
     : name{std::move(n)}, lower{std::move(a)}, upper{std::move(z)},
       step{std::move(s)} {}
   LoopBounds &operator=(LoopBounds &&) = default;
-  DoVariable name;
-  A lower, upper;
-  std::optional<A> step;
+  A name;
+  B lower, upper;
+  std::optional<B> step;
 };
 
+using ScalarName = Scalar<Name>;
+using ScalarExpr = Scalar<common::Indirection<Expr>>;
+
 // R775 ac-implied-do-control ->
 //        [integer-type-spec ::] ac-do-variable = scalar-int-expr ,
 //        scalar-int-expr [, scalar-int-expr]
 // R776 ac-do-variable -> do-variable
 struct AcImpliedDoControl {
   TUPLE_CLASS_BOILERPLATE(AcImpliedDoControl);
-  std::tuple<std::optional<IntegerTypeSpec>, LoopBounds<ScalarIntExpr>> t;
+  using Bounds = LoopBounds<DoVariable, ScalarIntExpr>;
+  std::tuple<std::optional<IntegerTypeSpec>, Bounds> t;
 };
 
 // R774 ac-implied-do -> ( ac-value-list , ac-implied-do-control )
@@ -1432,8 +1436,8 @@ struct DataIDoObject {
 // R842 data-i-do-variable -> do-variable
 struct DataImpliedDo {
   TUPLE_CLASS_BOILERPLATE(DataImpliedDo);
-  std::tuple<std::list<DataIDoObject>, std::optional<IntegerTypeSpec>,
-      LoopBounds<ScalarIntConstantExpr>>
+  using Bounds = LoopBounds<DoVariable, ScalarIntConstantExpr>;
+  std::tuple<std::list<DataIDoObject>, std::optional<IntegerTypeSpec>, Bounds>
       t;
 };
 
@@ -2186,7 +2190,8 @@ struct LoopControl {
     TUPLE_CLASS_BOILERPLATE(Concurrent);
     std::tuple<ConcurrentHeader, std::list<LocalitySpec>> t;
   };
-  std::variant<LoopBounds<ScalarIntExpr>, ScalarLogicalExpr, Concurrent> u;
+  using Bounds = LoopBounds<ScalarName, ScalarExpr>;
+  std::variant<Bounds, ScalarLogicalExpr, Concurrent> u;
 };
 
 // R1121 label-do-stmt -> [do-construct-name :] DO label [loop-control]
@@ -2657,7 +2662,7 @@ struct PrintStmt {
 
 // R1220 io-implied-do-control ->
 //         do-variable = scalar-int-expr , scalar-int-expr [, scalar-int-expr]
-using IoImpliedDoControl = LoopBounds<ScalarIntExpr>;
+using IoImpliedDoControl = LoopBounds<DoVariable, ScalarIntExpr>;
 
 // R1218 io-implied-do -> ( io-implied-do-object-list , io-implied-do-control )
 // R1219 io-implied-do-object -> input-item | output-item

flang/lib/parser/unparse.cc

@@ -386,7 +386,7 @@ public:
   void Unparse(const AcSpec &x) {  // R770
     Walk(x.type, "::"), Walk(x.values, ", ");
   }
-  template<typename A> void Unparse(const LoopBounds<A> &x) {
+  template<typename A, typename B> void Unparse(const LoopBounds<A, B> &x) {
     Walk(x.name), Put('='), Walk(x.lower), Put(','), Walk(x.upper);
     Walk(",", x.step);
   }
@@ -396,7 +396,7 @@ public:
   }
   void Unparse(const AcImpliedDoControl &x) {  // R775
     Walk(std::get<std::optional<IntegerTypeSpec>>(x.t), "::");
-    Walk(std::get<LoopBounds<ScalarIntExpr>>(x.t));
+    Walk(std::get<AcImpliedDoControl::Bounds>(x.t));
   }
 
   void Unparse(const TypeDeclarationStmt &x) {  // R801
@@ -598,7 +598,7 @@ public:
   void Unparse(const DataImpliedDo &x) {  // R840, R842
     Put('('), Walk(std::get<std::list<DataIDoObject>>(x.t), ", "), Put(',');
     Walk(std::get<std::optional<IntegerTypeSpec>>(x.t), "::");
-    Walk(std::get<LoopBounds<ScalarIntConstantExpr>>(x.t)), Put(')');
+    Walk(std::get<DataImpliedDo::Bounds>(x.t)), Put(')');
   }
   void Unparse(const DataStmtValue &x) {  // R843
     Walk(std::get<std::optional<DataStmtRepeat>>(x.t), "*");

flang/lib/semantics/expression.cc

@@ -1101,7 +1101,7 @@ void ArrayConstructorContext::Add(const parser::AcValue &x) {
             const auto &control{
                 std::get<parser::AcImpliedDoControl>(impliedDo.value().t)};
             const auto &bounds{
-                std::get<parser::LoopBounds<parser::ScalarIntExpr>>(control.t)};
+                std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
             Analyze(bounds.name);
             parser::CharBlock name{bounds.name.thing.thing.source};
             int kind{IntType::kind};

flang/lib/semantics/resolve-names.cc

@@ -978,7 +978,10 @@ public:
   void Post(const parser::AllocateObject &);
   bool Pre(const parser::PointerAssignmentStmt &);
   void Post(const parser::Designator &);
-  template<typename T> void Post(const parser::LoopBounds<T> &);
+  template<typename A, typename B>
+  void Post(const parser::LoopBounds<A, B> &x) {
+    ResolveName(*parser::Unwrap<parser::Name>(x.name));
+  }
   void Post(const parser::ProcComponentRef &);
   bool Pre(const parser::FunctionReference &);
   bool Pre(const parser::CallStmt &);
@@ -3812,7 +3815,7 @@ bool ConstructVisitor::Pre(const parser::AcImpliedDo &x) {
   auto &values{std::get<std::list<parser::AcValue>>(x.t)};
   auto &control{std::get<parser::AcImpliedDoControl>(x.t)};
   auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(control.t)};
-  auto &bounds{std::get<parser::LoopBounds<parser::ScalarIntExpr>>(control.t)};
+  auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
   DeclareStatementEntity(bounds.name.thing.thing, type);
   Walk(bounds);
   Walk(values);
@@ -3822,8 +3825,7 @@ bool ConstructVisitor::Pre(const parser::AcImpliedDo &x) {
 bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) {
   auto &objects{std::get<std::list<parser::DataIDoObject>>(x.t)};
   auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(x.t)};
-  auto &bounds{
-      std::get<parser::LoopBounds<parser::ScalarIntConstantExpr>>(x.t)};
+  auto &bounds{std::get<parser::DataImpliedDo::Bounds>(x.t)};
   DeclareStatementEntity(bounds.name.thing.thing, type);
   Walk(bounds);
   Walk(objects);
@@ -4558,10 +4560,6 @@ void ResolveNamesVisitor::Post(const parser::Designator &x) {
   ResolveDesignator(x);
 }
 
-template<typename T>
-void ResolveNamesVisitor::Post(const parser::LoopBounds<T> &x) {
-  ResolveName(x.name.thing.thing);
-}
 void ResolveNamesVisitor::Post(const parser::ProcComponentRef &x) {
   ResolveStructureComponent(x.v.thing);
 }