[flang] work in progress

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

diff --git a/flang/lib/evaluate/formatting.cc b/flang/lib/evaluate/formatting.cc
index c638578..dff43d2 100644 (file)
--- a/flang/lib/evaluate/formatting.cc
+++ b/flang/lib/evaluate/formatting.cc
@@ -16,6 +16,7 @@
 #include "call.h"
 #include "constant.h"
 #include "expression.h"
+#include "tools.h"
 #include "../parser/characters.h"
 #include "../semantics/symbol.h"
 
@@ -134,6 +135,7 @@ std::ostream &ProcedureRef::AsFortran(std::ostream &o) const {
 
 enum class Precedence {
   Primary,  // don't parenthesize
+  Constant,  // parenthesize if negative integer/real operand
   Parenthesize,  // (x), (real, imaginary)
   DefinedUnary,
   Negate,
@@ -147,7 +149,7 @@ enum class Precedence {
 };
 
 template<typename A> constexpr Precedence ToPrecedence{Precedence::Primary};
-
+template<typename T> constexpr Precedence ToPrecedence<Constant<T>>{Precedence::Constant};
 template<typename T>
 constexpr Precedence ToPrecedence<Parentheses<T>>{Precedence::Parenthesize};
 template<int KIND>
@@ -218,6 +220,14 @@ std::ostream &Operation<D, R, O...>::AsFortran(std::ostream &o) const {
     static constexpr Precedence thisPrec{ToPrecedence<D>};
     bool lhsParens{lhsPrec == Precedence::Parenthesize || lhsPrec > thisPrec ||
         (lhsPrec == thisPrec && lhsPrec == Precedence::Power)};
+    if constexpr (lhsPrec == Precedence::Constant && thisPrec != Precedence::Additive) {
+      static constexpr TypeCategory cat{Operand<0>::Result::category};
+      if constexpr (cat == TypeCategory::Integer || cat == TypeCategory::Real) {
+        const auto *p{UnwrapExpr<Constant<Operand<0>>>(left())};
+        CHECK(p != nullptr);
+        lhsParens |= p->size() == 1 && (*p)->IsNegative();
+      }
+    }
     if (lhsParens) {
       o << '(';
     }
@@ -226,7 +236,15 @@ std::ostream &Operation<D, R, O...>::AsFortran(std::ostream &o) const {
       o << ')';
     }
     static constexpr Precedence rhsPrec{ToPrecedence<Operand<1>>};
-    bool rhsParens{rhsPrec == Precedence::Parenthesize || rhsPrec > thisPrec};
+    bool rhsParens{rhsPrec == Precedence::Parenthesize || rhsPrec == Precedence::Negate || rhsPrec > thisPrec};
+    if constexpr (rhsPrec == Precedence::Constant) {
+      static constexpr TypeCategory cat{Operand<1>::Result::category};
+      if constexpr (cat == TypeCategory::Integer || cat == TypeCategory::Real) {
+        const auto *p{UnwrapExpr<Constant<Operand<1>>>(right())};
+        CHECK(p != nullptr);
+        rhsParens |= p->size() == 1 && (*p)->IsNegative();
+      }
+    }
     if (rhsParens) {
       o << '(';
     }
@@ -284,18 +302,18 @@ template<int KIND> const char *LogicalOperation<KIND>::Infix() const {
 }
 
 template<typename T>
-std::ostream &Emit(
+std::ostream &EmitArray(
     std::ostream &o, const common::CopyableIndirection<Expr<T>> &expr) {
   return expr.value().AsFortran(o);
 }
 
 template<typename T>
-std::ostream &Emit(std::ostream &, const ArrayConstructorValues<T> &);
+std::ostream &EmitArray(std::ostream &, const ArrayConstructorValues<T> &);
 
 template<typename T>
-std::ostream &Emit(std::ostream &o, const ImpliedDo<T> &implDo) {
+std::ostream &EmitArray(std::ostream &o, const ImpliedDo<T> &implDo) {
   o << '(';
-  Emit(o, implDo.values());
+  EmitArray(o, implDo.values());
   o << ',' << ImpliedDoIndex::Result::AsFortran()
     << "::" << implDo.name().ToString() << '=';
   implDo.lower().AsFortran(o) << ',';
@@ -305,11 +323,11 @@ std::ostream &Emit(std::ostream &o, const ImpliedDo<T> &implDo) {
 }
 
 template<typename T>
-std::ostream &Emit(std::ostream &o, const ArrayConstructorValues<T> &values) {
+std::ostream &EmitArray(std::ostream &o, const ArrayConstructorValues<T> &values) {
   const char *sep{""};
   for (const auto &value : values.values()) {
     o << sep;
-    std::visit([&](const auto &x) { Emit(o, x); }, value.u);
+    std::visit([&](const auto &x) { EmitArray(o, x); }, value.u);
     sep = ",";
   }
   return o;
@@ -318,7 +336,7 @@ std::ostream &Emit(std::ostream &o, const ArrayConstructorValues<T> &values) {
 template<typename T>
 std::ostream &ArrayConstructor<T>::AsFortran(std::ostream &o) const {
   o << '[' << GetType().AsFortran() << "::";
-  Emit(o, *this);
+  EmitArray(o, *this);
   return o << ']';
 }
 
@@ -328,13 +346,13 @@ std::ostream &ArrayConstructor<Type<TypeCategory::Character, KIND>>::AsFortran(
   std::stringstream len;
   LEN().AsFortran(len);
   o << '[' << GetType().AsFortran(len.str()) << "::";
-  Emit(o, *this);
+  EmitArray(o, *this);
   return o << ']';
 }
 
 std::ostream &ArrayConstructor<SomeDerived>::AsFortran(std::ostream &o) const {
   o << '[' << GetType().AsFortran() << "::";
-  Emit(o, *this);
+  EmitArray(o, *this);
   return o << ']';
 }
 
@@ -384,7 +402,169 @@ std::ostream &DerivedTypeSpecAsFortran(
   return o;
 }
 
+std::ostream &EmitVar(std::ostream &o, const Symbol &symbol) {
+  return o << symbol.name().ToString();
+}
+
+std::ostream &EmitVar(std::ostream &o, const std::string &lit) {
+  return o << parser::QuoteCharacterLiteral(lit);
+}
+
+std::ostream &EmitVar(std::ostream &o, const std::u16string &lit) {
+  return o << parser::QuoteCharacterLiteral(lit);
+}
+
+std::ostream &EmitVar(std::ostream &o, const std::u32string &lit) {
+  return o << parser::QuoteCharacterLiteral(lit);
+}
+
+template<typename A> std::ostream &EmitVar(std::ostream &o, const A &x) {
+  return x.AsFortran(o);
+}
+
+template<typename A>
+std::ostream &EmitVar(std::ostream &o, const A *p, const char *kw = nullptr) {
+  if (p != nullptr) {
+    if (kw != nullptr) {
+      o << kw;
+    }
+    EmitVar(o, *p);
+  }
+  return o;
+}
+
+template<typename A>
+std::ostream &EmitVar(
+    std::ostream &o, const std::optional<A> &x, const char *kw = nullptr) {
+  if (x.has_value()) {
+    if (kw != nullptr) {
+      o << kw;
+    }
+    EmitVar(o, *x);
+  }
+  return o;
+}
+
+template<typename A, bool COPY>
+std::ostream &EmitVar(std::ostream &o, const common::Indirection<A, COPY> &p,
+    const char *kw = nullptr) {
+  if (kw != nullptr) {
+    o << kw;
+  }
+  EmitVar(o, p.value());
+  return o;
+}
+
+template<typename A>
+std::ostream &EmitVar(std::ostream &o, const std::shared_ptr<A> &p) {
+  CHECK(p != nullptr);
+  return EmitVar(o, *p);
+}
+
+template<typename... A>
+std::ostream &EmitVar(std::ostream &o, const std::variant<A...> &u) {
+  std::visit([&](const auto &x) { EmitVar(o, x); }, u);
+  return o;
+}
+
+std::ostream &BaseObject::AsFortran(std::ostream &o) const {
+  return EmitVar(o, u);
+}
+
+template<int KIND>
+std::ostream &TypeParamInquiry<KIND>::AsFortran(std::ostream &o) const {
+  std::visit(
+      common::visitors{
+          [&](const Symbol *sym) {
+            if (sym != nullptr) {
+              EmitVar(o, *sym) << '%';
+            }
+          },
+          [&](const Component &comp) { EmitVar(o, comp) << '%'; },
+      },
+      base_);
+  return EmitVar(o, *parameter_);
+}
+
+std::ostream &Component::AsFortran(std::ostream &o) const {
+  base_.value().AsFortran(o);
+  return EmitVar(o << '%', *symbol_);
+}
+
+std::ostream &Triplet::AsFortran(std::ostream &o) const {
+  EmitVar(o, lower_) << ':';
+  EmitVar(o, upper_);
+  EmitVar(o << ':', stride_.value());
+  return o;
+}
+
+std::ostream &Subscript::AsFortran(std::ostream &o) const { return EmitVar(o, u); }
+
+std::ostream &ArrayRef::AsFortran(std::ostream &o) const {
+  EmitVar(o, base_);
+  char separator{'('};
+  for (const Subscript &ss : subscript_) {
+    ss.AsFortran(o << separator);
+    separator = ',';
+  }
+  return o << ')';
+}
+
+std::ostream &CoarrayRef::AsFortran(std::ostream &o) const {
+  for (const Symbol *sym : base_) {
+    EmitVar(o, *sym);
+  }
+  char separator{'('};
+  for (const auto &ss : subscript_) {
+    EmitVar(o << separator, ss);
+    separator = ',';
+  }
+  if (separator == ',') {
+    o << ')';
+  }
+  separator = '[';
+  for (const auto &css : cosubscript_) {
+    EmitVar(o << separator, css);
+    separator = ',';
+  }
+  if (stat_.has_value()) {
+    EmitVar(o << separator, stat_, "STAT=");
+    separator = ',';
+  }
+  if (team_.has_value()) {
+    EmitVar(o << separator, team_, teamIsTeamNumber_ ? "TEAM_NUMBER=" : "TEAM=");
+  }
+  return o << ']';
+}
+
+std::ostream &DataRef::AsFortran(std::ostream &o) const { return EmitVar(o, u); }
+
+std::ostream &Substring::AsFortran(std::ostream &o) const {
+  EmitVar(o, parent_) << '(';
+  EmitVar(o, lower_) << ':';
+  return EmitVar(o, upper_);
+}
+
+std::ostream &ComplexPart::AsFortran(std::ostream &o) const {
+  return complex_.AsFortran(o) << '%' << EnumToString(part_);
+}
+
+std::ostream &ProcedureDesignator::AsFortran(std::ostream &o) const {
+  return EmitVar(o, u);
+}
+
+template<typename T>
+std::ostream &Designator<T>::AsFortran(std::ostream &o) const {
+  std::visit(
+      common::visitors{
+          [&](const Symbol *sym) { EmitVar(o, *sym); },
+          [&](const auto &x) { x.AsFortran(o); },
+      },
+      u);
+  return o;
+}
+
 INSTANTIATE_CONSTANT_TEMPLATES
 INSTANTIATE_EXPRESSION_TEMPLATES
-// TODO variable templates and call templates?
+INSTANTIATE_VARIABLE_TEMPLATES
 }

diff --git a/flang/lib/evaluate/variable.cc b/flang/lib/evaluate/variable.cc
index 8fa75e9..7ec3b81 100644 (file)
--- a/flang/lib/evaluate/variable.cc
+++ b/flang/lib/evaluate/variable.cc
@@ -213,170 +213,6 @@ std::optional<Expr<SomeCharacter>> Substring::Fold(FoldingContext &context) {
   return std::nullopt;
 }
 
-// Variable formatting
-
-std::ostream &Emit(std::ostream &o, const Symbol &symbol) {
-  return o << symbol.name().ToString();
-}
-
-std::ostream &Emit(std::ostream &o, const std::string &lit) {
-  return o << parser::QuoteCharacterLiteral(lit);
-}
-
-std::ostream &Emit(std::ostream &o, const std::u16string &lit) {
-  return o << parser::QuoteCharacterLiteral(lit);
-}
-
-std::ostream &Emit(std::ostream &o, const std::u32string &lit) {
-  return o << parser::QuoteCharacterLiteral(lit);
-}
-
-template<typename A> std::ostream &Emit(std::ostream &o, const A &x) {
-  return x.AsFortran(o);
-}
-
-template<typename A>
-std::ostream &Emit(std::ostream &o, const A *p, const char *kw = nullptr) {
-  if (p != nullptr) {
-    if (kw != nullptr) {
-      o << kw;
-    }
-    Emit(o, *p);
-  }
-  return o;
-}
-
-template<typename A>
-std::ostream &Emit(
-    std::ostream &o, const std::optional<A> &x, const char *kw = nullptr) {
-  if (x.has_value()) {
-    if (kw != nullptr) {
-      o << kw;
-    }
-    Emit(o, *x);
-  }
-  return o;
-}
-
-template<typename A, bool COPY>
-std::ostream &Emit(std::ostream &o, const common::Indirection<A, COPY> &p,
-    const char *kw = nullptr) {
-  if (kw != nullptr) {
-    o << kw;
-  }
-  Emit(o, p.value());
-  return o;
-}
-
-template<typename A>
-std::ostream &Emit(std::ostream &o, const std::shared_ptr<A> &p) {
-  CHECK(p != nullptr);
-  return Emit(o, *p);
-}
-
-template<typename... A>
-std::ostream &Emit(std::ostream &o, const std::variant<A...> &u) {
-  std::visit([&](const auto &x) { Emit(o, x); }, u);
-  return o;
-}
-
-std::ostream &BaseObject::AsFortran(std::ostream &o) const {
-  return Emit(o, u);
-}
-
-template<int KIND>
-std::ostream &TypeParamInquiry<KIND>::AsFortran(std::ostream &o) const {
-  std::visit(
-      common::visitors{
-          [&](const Symbol *sym) {
-            if (sym != nullptr) {
-              Emit(o, *sym) << '%';
-            }
-          },
-          [&](const Component &comp) { Emit(o, comp) << '%'; },
-      },
-      base_);
-  return Emit(o, *parameter_);
-}
-
-std::ostream &Component::AsFortran(std::ostream &o) const {
-  base_.value().AsFortran(o);
-  return Emit(o << '%', *symbol_);
-}
-
-std::ostream &Triplet::AsFortran(std::ostream &o) const {
-  Emit(o, lower_) << ':';
-  Emit(o, upper_);
-  Emit(o << ':', stride_.value());
-  return o;
-}
-
-std::ostream &Subscript::AsFortran(std::ostream &o) const { return Emit(o, u); }
-
-std::ostream &ArrayRef::AsFortran(std::ostream &o) const {
-  Emit(o, base_);
-  char separator{'('};
-  for (const Subscript &ss : subscript_) {
-    ss.AsFortran(o << separator);
-    separator = ',';
-  }
-  return o << ')';
-}
-
-std::ostream &CoarrayRef::AsFortran(std::ostream &o) const {
-  for (const Symbol *sym : base_) {
-    Emit(o, *sym);
-  }
-  char separator{'('};
-  for (const auto &ss : subscript_) {
-    Emit(o << separator, ss);
-    separator = ',';
-  }
-  if (separator == ',') {
-    o << ')';
-  }
-  separator = '[';
-  for (const auto &css : cosubscript_) {
-    Emit(o << separator, css);
-    separator = ',';
-  }
-  if (stat_.has_value()) {
-    Emit(o << separator, stat_, "STAT=");
-    separator = ',';
-  }
-  if (team_.has_value()) {
-    Emit(o << separator, team_, teamIsTeamNumber_ ? "TEAM_NUMBER=" : "TEAM=");
-  }
-  return o << ']';
-}
-
-std::ostream &DataRef::AsFortran(std::ostream &o) const { return Emit(o, u); }
-
-std::ostream &Substring::AsFortran(std::ostream &o) const {
-  Emit(o, parent_) << '(';
-  Emit(o, lower_) << ':';
-  return Emit(o, upper_);
-}
-
-std::ostream &ComplexPart::AsFortran(std::ostream &o) const {
-  return complex_.AsFortran(o) << '%' << EnumToString(part_);
-}
-
-std::ostream &ProcedureDesignator::AsFortran(std::ostream &o) const {
-  return Emit(o, u);
-}
-
-template<typename T>
-std::ostream &Designator<T>::AsFortran(std::ostream &o) const {
-  std::visit(
-      common::visitors{
-          [&](const Symbol *sym) { Emit(o, *sym); },
-          [&](const auto &x) { x.AsFortran(o); },
-      },
-      u);
-  return o;
-}
-
 // LEN()
 static Expr<SubscriptInteger> SymbolLEN(const Symbol &sym) {
   return AsExpr(Constant<SubscriptInteger>{0});  // TODO
@@ -683,7 +519,5 @@ bool ProcedureRef::operator==(const ProcedureRef &that) const {
   return proc_ == that.proc_ && arguments_ == that.arguments_;
 }
 
-EXPAND_FOR_EACH_INTEGER_KIND(
-    TEMPLATE_INSTANTIATION, template class TypeParamInquiry, )
-FOR_EACH_SPECIFIC_TYPE(template class Designator, )
+INSTANTIATE_VARIABLE_TEMPLATES
 }

diff --git a/flang/lib/evaluate/variable.h b/flang/lib/evaluate/variable.h
index 8a946e8..75f4672 100644 (file)
--- a/flang/lib/evaluate/variable.h
+++ b/flang/lib/evaluate/variable.h
@@ -374,5 +374,10 @@ template<typename T> struct Variable {
   }
   std::variant<Designator<Result>, FunctionRef<Result>> u;
 };
+
+#define INSTANTIATE_VARIABLE_TEMPLATES \
+  EXPAND_FOR_EACH_INTEGER_KIND(  \
+    TEMPLATE_INSTANTIATION, template class TypeParamInquiry, ) \
+  FOR_EACH_SPECIFIC_TYPE(template class Designator, )
 }
 #endif  // FORTRAN_EVALUATE_VARIABLE_H_

diff --git a/flang/test/evaluate/expression.cc b/flang/test/evaluate/expression.cc
index fd0ef32..de28e67 100644 (file)
--- a/flang/test/evaluate/expression.cc
+++ b/flang/test/evaluate/expression.cc
@@ -34,16 +34,16 @@ int main() {
   using DefaultIntegerExpr = Expr<Type<TypeCategory::Integer, 4>>;
   TEST(DefaultIntegerExpr::Result::AsFortran() == "Integer(4)");
   MATCH("666_4", AsFortran(DefaultIntegerExpr{666}));
-  MATCH("(-1_4)", AsFortran(-DefaultIntegerExpr{1}));
+  MATCH("-1_4", AsFortran(-DefaultIntegerExpr{1}));
   auto ex1{
       DefaultIntegerExpr{2} + DefaultIntegerExpr{3} * -DefaultIntegerExpr{4}};
-  MATCH("(2_4+(3_4*(-4_4)))", AsFortran(ex1));
+  MATCH("2_4+3_4*(-4_4))", AsFortran(ex1));
   Fortran::parser::CharBlock src;
   Fortran::parser::ContextualMessages messages{src, nullptr};
   FoldingContext context{messages};
   ex1 = Fold(context, std::move(ex1));
   MATCH("-10_4", AsFortran(ex1));
-  MATCH("(1_4/2_4)", AsFortran(DefaultIntegerExpr{1} / DefaultIntegerExpr{2}));
+  MATCH("1_4/2_4", AsFortran(DefaultIntegerExpr{1} / DefaultIntegerExpr{2}));
   DefaultIntegerExpr a{1};
   DefaultIntegerExpr b{2};
   MATCH("1_4", AsFortran(a));

diff --git a/flang/test/semantics/modfile13.f90 b/flang/test/semantics/modfile13.f90
index 006bf3c..16348c6 100644 (file)
--- a/flang/test/semantics/modfile13.f90
+++ b/flang/test/semantics/modfile13.f90
@@ -38,9 +38,9 @@ end
 !contains
 !  subroutine s(n,a,b,c,d)
 !    integer(4)::n
-!    character((n+1_4),1)::a
-!    character((n+2_4),2)::b
-!    character((n+3_4),1)::c
+!    character(n+1_4,1)::a
+!    character(n+2_4,2)::b
+!    character(n+3_4,1)::c
 !    character(*,1)::d
 !  end
 !end

diff --git a/flang/test/semantics/modfile17.f90 b/flang/test/semantics/modfile17.f90
index 3583e70..855d1ac 100644 (file)
--- a/flang/test/semantics/modfile17.f90
+++ b/flang/test/semantics/modfile17.f90
@@ -111,9 +111,9 @@ end module
 !end type
 !type::defaulted(n1,n2,n4,n8)
 !integer(1),kind::n1=1_4
-!integer(2),kind::n2=(int(n1,kind=4)*2_4)
-!integer(4),kind::n4=(2_4*int(n2,kind=4))
-!integer(8),kind::n8=(12_4-n4)
+!integer(2),kind::n2=int(n1,kind=4)*2_4
+!integer(4),kind::n4=2_4*int(n2,kind=4)
+!integer(8),kind::n8=12_4-n4
 !type(capture(k1=n1,k2=n2,k4=n4,k8=n8))::cap
 !end type
 !type,extends(defaulted)::extension(k5)