[flang] Move some AsFortran() implementations into new formatting.cc; use precedence...
authorpeter klausler <pklausler@nvidia.com>
Wed, 27 Mar 2019 22:27:33 +0000 (15:27 -0700)
committerpeter klausler <pklausler@nvidia.com>
Mon, 1 Apr 2019 17:58:55 +0000 (10:58 -0700)
Original-commit: flang-compiler/f18@2b5fa051df3c8e183349388181e66e085385396e
Reviewed-on: https://github.com/flang-compiler/f18/pull/371
Tree-same-pre-rewrite: false

20 files changed:
flang/lib/FIR/statements.cc
flang/lib/evaluate/CMakeLists.txt
flang/lib/evaluate/call.cc
flang/lib/evaluate/call.h
flang/lib/evaluate/complex.h
flang/lib/evaluate/constant.cc
flang/lib/evaluate/constant.h
flang/lib/evaluate/expression.cc
flang/lib/evaluate/expression.h
flang/lib/evaluate/fold.cc
flang/lib/evaluate/formatting.cc [new file with mode: 0644]
flang/lib/evaluate/formatting.h [new file with mode: 0644]
flang/lib/evaluate/real.h
flang/lib/evaluate/static-data.h
flang/lib/evaluate/type.h
flang/lib/evaluate/variable.cc
flang/lib/evaluate/variable.h
flang/lib/semantics/mod-file.cc
flang/lib/semantics/symbol.cc
flang/lib/semantics/type.cc

index a41d097..b1d3bcc 100644 (file)
@@ -30,7 +30,7 @@ Addressable_impl *GetAddressable(Statement *stmt) {
 
 static std::string dump(const Expression &e) {
   std::stringstream stringStream;
-  e.AsFortran(stringStream);
+  stringStream << e.v;
   return stringStream.str();
 }
 
index df8730f..f2faa17 100644 (file)
@@ -21,6 +21,7 @@ add_library(FortranEvaluate
   decimal.cc
   expression.cc
   fold.cc
+  formatting.cc
   host.cc
   integer.cc
   intrinsics.cc
index aefb901..102b9fe 100644 (file)
@@ -29,16 +29,6 @@ bool ActualArgument::operator==(const ActualArgument &that) const {
       isAlternateReturn == that.isAlternateReturn && value() == that.value();
 }
 
-std::ostream &ActualArgument::AsFortran(std::ostream &o) const {
-  if (keyword.has_value()) {
-    o << keyword->ToString() << '=';
-  }
-  if (isAlternateReturn) {
-    o << '*';
-  }
-  return value().AsFortran(o);
-}
-
 std::optional<int> ActualArgument::VectorSize() const {
   if (Rank() != 1) {
     return std::nullopt;
@@ -52,10 +42,6 @@ bool SpecificIntrinsic::operator==(const SpecificIntrinsic &that) const {
       attrs == that.attrs;
 }
 
-std::ostream &SpecificIntrinsic::AsFortran(std::ostream &o) const {
-  return o << name;
-}
-
 std::optional<DynamicType> ProcedureDesignator::GetType() const {
   if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&u)}) {
     return intrinsic->type;
@@ -96,26 +82,11 @@ const Symbol *ProcedureDesignator::GetSymbol() const {
       u);
 }
 
-std::ostream &ProcedureRef::AsFortran(std::ostream &o) const {
-  proc_.AsFortran(o);
-  char separator{'('};
-  for (const auto &arg : arguments_) {
-    if (arg.has_value()) {
-      arg->AsFortran(o << separator);
-      separator = ',';
-    }
-  }
-  if (separator == '(') {
-    o << '(';
-  }
-  return o << ')';
-}
-
 Expr<SubscriptInteger> ProcedureRef::LEN() const {
   // TODO: the results of the intrinsic functions REPEAT and TRIM have
   // unpredictable lengths; maybe the concept of LEN() has to become dynamic
   return proc_.LEN();
 }
 
-FOR_EACH_SPECIFIC_TYPE(template class FunctionRef)
+FOR_EACH_SPECIFIC_TYPE(template class FunctionRef)
 }
index 0ae8565..5b11df1 100644 (file)
@@ -17,6 +17,7 @@
 
 #include "common.h"
 #include "constant.h"
+#include "formatting.h"
 #include "type.h"
 #include "../common/indirection.h"
 #include "../parser/char-block.h"
@@ -134,6 +135,6 @@ public:
   std::optional<Constant<Result>> Fold(FoldingContext &);  // for intrinsics
 };
 
-FOR_EACH_SPECIFIC_TYPE(extern template class FunctionRef)
+FOR_EACH_SPECIFIC_TYPE(extern template class FunctionRef)
 }
 #endif  // FORTRAN_EVALUATE_CALL_H_
index 41fcae4..26a47c1 100644 (file)
@@ -15,6 +15,7 @@
 #ifndef FORTRAN_EVALUATE_COMPLEX_H_
 #define FORTRAN_EVALUATE_COMPLEX_H_
 
+#include "formatting.h"
 #include "real.h"
 #include <string>
 
index d09a4d3..2e2cc73 100644 (file)
@@ -15,7 +15,6 @@
 #include "constant.h"
 #include "expression.h"
 #include "type.h"
-#include "../parser/characters.h"
 #include <string>
 
 namespace Fortran::evaluate {
@@ -23,59 +22,6 @@ namespace Fortran::evaluate {
 template<typename RESULT, typename VALUE>
 ConstantBase<RESULT, VALUE>::~ConstantBase() {}
 
-static void ShapeAsFortran(
-    std::ostream &o, const std::vector<std::int64_t> &shape) {
-  if (shape.size() > 1) {
-    o << ",shape=";
-    char ch{'['};
-    for (auto dim : shape) {
-      o << ch << dim;
-      ch = ',';
-    }
-    o << "])";
-  }
-}
-
-template<typename RESULT, typename VALUE>
-std::ostream &ConstantBase<RESULT, VALUE>::AsFortran(std::ostream &o) const {
-  if (Rank() > 1) {
-    o << "reshape(";
-  }
-  if (Rank() > 0) {
-    o << '[' << GetType().AsFortran() << "::";
-  }
-  bool first{true};
-  for (const auto &value : values_) {
-    if (first) {
-      first = false;
-    } else {
-      o << ',';
-    }
-    if constexpr (Result::category == TypeCategory::Integer) {
-      o << value.SignedDecimal() << '_' << Result::kind;
-    } else if constexpr (Result::category == TypeCategory::Real ||
-        Result::category == TypeCategory::Complex) {
-      value.AsFortran(o, Result::kind);
-    } else if constexpr (Result::category == TypeCategory::Character) {
-      o << Result::kind << '_' << parser::QuoteCharacterLiteral(value);
-    } else if constexpr (Result::category == TypeCategory::Logical) {
-      if (value.IsTrue()) {
-        o << ".true.";
-      } else {
-        o << ".false.";
-      }
-      o << '_' << Result::kind;
-    } else {
-      StructureConstructor{AsConstant().derivedTypeSpec(), value}.AsFortran(o);
-    }
-  }
-  if (Rank() > 0) {
-    o << ']';
-  }
-  ShapeAsFortran(o, shape_);
-  return o;
-}
-
 static std::int64_t SubscriptsToOffset(const std::vector<std::int64_t> &index,
     const std::vector<std::int64_t> &shape) {
   CHECK(index.size() == shape.size());
@@ -178,32 +124,6 @@ Constant<Type<TypeCategory::Character, KIND>>::SHAPE() const {
   return ShapeAsConstant(shape_);
 }
 
-template<int KIND>
-std::ostream &Constant<Type<TypeCategory::Character, KIND>>::AsFortran(
-    std::ostream &o) const {
-  if (Rank() > 1) {
-    o << "reshape(";
-  }
-  if (Rank() > 0) {
-    o << '[' << GetType().AsFortran(std::to_string(length_)) << "::";
-  }
-  auto total{static_cast<std::int64_t>(size())};
-  for (std::int64_t j{0}; j < total; ++j) {
-    ScalarValue value{values_.substr(j * length_, length_)};
-    if (j > 0) {
-      o << ',';
-    } else if (Rank() == 0) {
-      o << Result::kind << '_';
-    }
-    o << parser::QuoteCharacterLiteral(value);
-  }
-  if (Rank() > 0) {
-    o << ']';
-  }
-  ShapeAsFortran(o, shape_);
-  return o;
-}
-
 // Constant<SomeDerived> specialization
 Constant<SomeDerived>::Constant(const StructureConstructor &x)
   : Base{x.values()}, derivedTypeSpec_{&x.derivedTypeSpec()} {}
@@ -228,7 +148,5 @@ Constant<SomeDerived>::Constant(const semantics::DerivedTypeSpec &spec,
     std::vector<StructureConstructor> &&x, std::vector<std::int64_t> &&s)
   : Base{GetValues(std::move(x)), std::move(s)}, derivedTypeSpec_{&spec} {}
 
-FOR_EACH_LENGTHLESS_INTRINSIC_KIND(template class ConstantBase)
-template class ConstantBase<SomeDerived, StructureConstructorValues>;
-FOR_EACH_INTRINSIC_KIND(template class Constant)
+INSTANTIATE_CONSTANT_TEMPLATES
 }
index cb33967..78cb69b 100644 (file)
@@ -15,6 +15,7 @@
 #ifndef FORTRAN_EVALUATE_CONSTANT_H_
 #define FORTRAN_EVALUATE_CONSTANT_H_
 
+#include "formatting.h"
 #include "type.h"
 #include <map>
 #include <ostream>
@@ -55,6 +56,7 @@ public:
   }
   bool empty() const { return values_.empty(); }
   std::size_t size() const { return values_.size(); }
+  const std::vector<ScalarValue> &values() const { return values_; }
   const std::vector<std::int64_t> &shape() const { return shape_; }
 
   ScalarValue operator*() const {
@@ -155,8 +157,13 @@ private:
   const semantics::DerivedTypeSpec *derivedTypeSpec_;
 };
 
-FOR_EACH_LENGTHLESS_INTRINSIC_KIND(extern template class ConstantBase)
+FOR_EACH_LENGTHLESS_INTRINSIC_KIND(extern template class ConstantBase)
 extern template class ConstantBase<SomeDerived, StructureConstructorValues>;
-FOR_EACH_INTRINSIC_KIND(extern template class Constant)
+FOR_EACH_INTRINSIC_KIND(extern template class Constant, )
+
+#define INSTANTIATE_CONSTANT_TEMPLATES \
+  FOR_EACH_LENGTHLESS_INTRINSIC_KIND(template class ConstantBase, ) \
+  template class ConstantBase<SomeDerived, StructureConstructorValues>; \
+  FOR_EACH_INTRINSIC_KIND(template class Constant, )
 }
 #endif  // FORTRAN_EVALUATE_CONSTANT_H_
index d286a70..399881e 100644 (file)
@@ -19,8 +19,6 @@
 #include "variable.h"
 #include "../common/idioms.h"
 #include "../parser/message.h"
-#include <ostream>
-#include <sstream>
 #include <string>
 #include <type_traits>
 
@@ -28,136 +26,6 @@ using namespace Fortran::parser::literals;
 
 namespace Fortran::evaluate {
 
-// AsFortran() formatting
-
-template<typename D, typename R, typename... O>
-std::ostream &Operation<D, R, O...>::AsFortran(std::ostream &o) const {
-  left().AsFortran(derived().Prefix(o));
-  if constexpr (operands > 1) {
-    right().AsFortran(derived().Infix(o));
-  }
-  return derived().Suffix(o);
-}
-
-template<typename TO, TypeCategory FROMCAT>
-std::ostream &Convert<TO, FROMCAT>::AsFortran(std::ostream &o) const {
-  static_assert(TO::category == TypeCategory::Integer ||
-      TO::category == TypeCategory::Real ||
-      TO::category == TypeCategory::Character ||
-      TO::category == TypeCategory::Logical || !"Convert<> to bad category!");
-  if constexpr (TO::category == TypeCategory::Character) {
-    this->left().AsFortran(o << "achar(iachar(") << ')';
-  } else if constexpr (TO::category == TypeCategory::Integer) {
-    this->left().AsFortran(o << "int(");
-  } else if constexpr (TO::category == TypeCategory::Real) {
-    this->left().AsFortran(o << "real(");
-  } else {
-    this->left().AsFortran(o << "logical(");
-  }
-  return o << ",kind=" << TO::kind << ')';
-}
-
-template<typename A> std::ostream &Relational<A>::Infix(std::ostream &o) const {
-  switch (opr) {
-  case RelationalOperator::LT: o << '<'; break;
-  case RelationalOperator::LE: o << "<="; break;
-  case RelationalOperator::EQ: o << "=="; break;
-  case RelationalOperator::NE: o << "/="; break;
-  case RelationalOperator::GE: o << ">="; break;
-  case RelationalOperator::GT: o << '>'; break;
-  }
-  return o;
-}
-
-std::ostream &Relational<SomeType>::AsFortran(std::ostream &o) const {
-  std::visit([&](const auto &rel) { rel.AsFortran(o); }, u);
-  return o;
-}
-
-template<int KIND>
-std::ostream &LogicalOperation<KIND>::Infix(std::ostream &o) const {
-  switch (logicalOperator) {
-  case LogicalOperator::And: o << ".and."; break;
-  case LogicalOperator::Or: o << ".or."; break;
-  case LogicalOperator::Eqv: o << ".eqv."; break;
-  case LogicalOperator::Neqv: o << ".neqv."; break;
-  }
-  return o;
-}
-
-template<typename T>
-std::ostream &Emit(
-    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> &);
-
-template<typename T>
-std::ostream &Emit(std::ostream &o, const ImpliedDo<T> &implDo) {
-  o << '(';
-  Emit(o, implDo.values());
-  o << ',' << ImpliedDoIndex::Result::AsFortran()
-    << "::" << implDo.name().ToString() << '=';
-  implDo.lower().AsFortran(o) << ',';
-  implDo.upper().AsFortran(o) << ',';
-  implDo.stride().AsFortran(o) << ')';
-  return o;
-}
-
-template<typename T>
-std::ostream &Emit(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);
-    sep = ",";
-  }
-  return o;
-}
-
-template<typename T>
-std::ostream &ArrayConstructor<T>::AsFortran(std::ostream &o) const {
-  o << '[' << GetType().AsFortran() << "::";
-  Emit(o, *this);
-  return o << ']';
-}
-
-template<int KIND>
-std::ostream &ArrayConstructor<Type<TypeCategory::Character, KIND>>::AsFortran(
-    std::ostream &o) const {
-  std::stringstream len;
-  LEN().AsFortran(len);
-  o << '[' << GetType().AsFortran(len.str()) << "::";
-  Emit(o, *this);
-  return o << ']';
-}
-
-std::ostream &ArrayConstructor<SomeDerived>::AsFortran(std::ostream &o) const {
-  o << '[' << GetType().AsFortran() << "::";
-  Emit(o, *this);
-  return o << ']';
-}
-
-template<typename RESULT>
-std::ostream &ExpressionBase<RESULT>::AsFortran(std::ostream &o) const {
-  std::visit(
-      common::visitors{
-          [&](const BOZLiteralConstant &x) {
-            o << "z'" << x.Hexadecimal() << "'";
-          },
-          [&](const NullPointer &) { o << "NULL()"; },
-          [&](const common::CopyableIndirection<Substring> &s) {
-            s.value().AsFortran(o);
-          },
-          [&](const ImpliedDoIndex &i) { o << i.name.ToString(); },
-          [&](const auto &x) { x.AsFortran(o); },
-      },
-      derived().u);
-  return o;
-}
-
 template<int KIND>
 Expr<SubscriptInteger> Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
   return std::visit(
@@ -285,34 +153,6 @@ StructureConstructor &StructureConstructor::Add(
   return *this;
 }
 
-std::ostream &StructureConstructor::AsFortran(std::ostream &o) const {
-  DerivedTypeSpecAsFortran(o, *derivedTypeSpec_);
-  if (values_.empty()) {
-    o << '(';
-  } else {
-    char ch{'('};
-    for (const auto &[symbol, value] : values_) {
-      value.value().AsFortran(o << ch << symbol->name().ToString() << '=');
-      ch = ',';
-    }
-  }
-  return o << ')';
-}
-
-std::ostream &DerivedTypeSpecAsFortran(
-    std::ostream &o, const semantics::DerivedTypeSpec &spec) {
-  o << spec.typeSymbol().name().ToString();
-  if (!spec.parameters().empty()) {
-    char ch{'('};
-    for (const auto &[name, value] : spec.parameters()) {
-      value.GetExplicit()->AsFortran(o << ch << name.ToString() << '=');
-      ch = ',';
-    }
-    o << ')';
-  }
-  return o;
-}
-
 GenericExprWrapper::~GenericExprWrapper() = default;
 
 bool GenericExprWrapper::operator==(const GenericExprWrapper &that) const {
@@ -335,17 +175,6 @@ Expr<SubscriptInteger> Expr<SomeCharacter>::LEN() const {
   return std::visit([](const auto &kx) { return kx.LEN(); }, u);
 }
 
-// Template instantiations to resolve the "extern template" declarations
-// that appear in expression.h.
-
-FOR_EACH_INTRINSIC_KIND(template class Expr)
-FOR_EACH_CATEGORY_TYPE(template class Expr)
-FOR_EACH_INTEGER_KIND(template struct Relational)
-FOR_EACH_REAL_KIND(template struct Relational)
-FOR_EACH_CHARACTER_KIND(template struct Relational)
-template struct Relational<SomeType>;
-FOR_EACH_TYPE_AND_KIND(template class ExpressionBase)
-FOR_EACH_INTRINSIC_KIND(template class ArrayConstructorValues)
-FOR_EACH_INTRINSIC_KIND(template class ArrayConstructor)
+INSTANTIATE_EXPRESSION_TEMPLATES
 }
 DEFINE_DELETER(Fortran::evaluate::GenericExprWrapper)
index 002e04d..a803de0 100644 (file)
@@ -24,6 +24,7 @@
 
 #include "common.h"
 #include "constant.h"
+#include "formatting.h"
 #include "type.h"
 #include "variable.h"
 #include "../lib/common/Fortran.h"
@@ -194,9 +195,9 @@ public:
 
 protected:
   // Overridable functions for AsFortran()
-  static std::ostream &Prefix(std::ostream &o) { return o << '('; }
-  static std::ostream &Infix(std::ostream &o) { return o << ','; }
-  static std::ostream &Suffix(std::ostream &o) { return o << ')'; }
+  static const char *Prefix() { return ""; }
+  static const char *Infix() { return ""; }
+  static const char *Suffix() { return ""; }
 
 private:
   Container operand_;
@@ -239,7 +240,7 @@ template<typename A> struct Negate : public Operation<Negate<A>, A, A> {
   using Operand = A;
   using Base = Operation<Negate, A, A>;
   using Base::Base;
-  static std::ostream &Prefix(std::ostream &o) { return o << "(-"; }
+  static const char *Prefix() { return "-"; }
 };
 
 template<int KIND>
@@ -255,9 +256,7 @@ struct ComplexComponent
   ComplexComponent(bool isImaginary, Expr<Operand> &&x)
     : Base{std::move(x)}, isImaginaryPart{isImaginary} {}
 
-  std::ostream &Suffix(std::ostream &o) const {
-    return o << (isImaginaryPart ? "%IM)" : "%RE)");
-  }
+  const char *Suffix() const { return isImaginaryPart ? "%IM)" : "%RE)"; }
 
   bool isImaginaryPart{true};
 };
@@ -269,7 +268,7 @@ struct Not : public Operation<Not<KIND>, Type<TypeCategory::Logical, KIND>,
   using Operand = Result;
   using Base = Operation<Not, Result, Operand>;
   using Base::Base;
-  static std::ostream &Prefix(std::ostream &o) { return o << "(.NOT."; }
+  static const char *Prefix() { return ".NOT."; }
 };
 
 // Character lengths are determined by context in Fortran and do not
@@ -285,7 +284,7 @@ struct SetLength
   using LengthOperand = SubscriptInteger;
   using Base = Operation<SetLength, Result, CharacterOperand, LengthOperand>;
   using Base::Base;
-  static std::ostream &Prefix(std::ostream &o) { return o << "%SET_LENGTH("; }
+  static const char *Prefix() { return "%SET_LENGTH("; }
 };
 
 // Binary operations
@@ -295,7 +294,7 @@ template<typename A> struct Add : public Operation<Add<A>, A, A, A> {
   using Operand = A;
   using Base = Operation<Add, A, A, A>;
   using Base::Base;
-  static std::ostream &Infix(std::ostream &o) { return o << '+'; }
+  static const char *Infix() { return "+"; }
 };
 
 template<typename A> struct Subtract : public Operation<Subtract<A>, A, A, A> {
@@ -303,7 +302,7 @@ template<typename A> struct Subtract : public Operation<Subtract<A>, A, A, A> {
   using Operand = A;
   using Base = Operation<Subtract, A, A, A>;
   using Base::Base;
-  static std::ostream &Infix(std::ostream &o) { return o << '-'; }
+  static const char *Infix() { return "-"; }
 };
 
 template<typename A> struct Multiply : public Operation<Multiply<A>, A, A, A> {
@@ -311,7 +310,7 @@ template<typename A> struct Multiply : public Operation<Multiply<A>, A, A, A> {
   using Operand = A;
   using Base = Operation<Multiply, A, A, A>;
   using Base::Base;
-  static std::ostream &Infix(std::ostream &o) { return o << '*'; }
+  static const char *Infix() { return "*"; }
 };
 
 template<typename A> struct Divide : public Operation<Divide<A>, A, A, A> {
@@ -319,7 +318,7 @@ template<typename A> struct Divide : public Operation<Divide<A>, A, A, A> {
   using Operand = A;
   using Base = Operation<Divide, A, A, A>;
   using Base::Base;
-  static std::ostream &Infix(std::ostream &o) { return o << '/'; }
+  static const char *Infix() { return "/"; }
 };
 
 template<typename A> struct Power : public Operation<Power<A>, A, A, A> {
@@ -327,7 +326,7 @@ template<typename A> struct Power : public Operation<Power<A>, A, A, A> {
   using Operand = A;
   using Base = Operation<Power, A, A, A>;
   using Base::Base;
-  static std::ostream &Infix(std::ostream &o) { return o << "**"; }
+  static const char *Infix() { return "**"; }
 };
 
 template<typename A>
@@ -337,7 +336,7 @@ struct RealToIntPower : public Operation<RealToIntPower<A>, A, A, SomeInteger> {
   using BaseOperand = A;
   using ExponentOperand = SomeInteger;
   using Base::Base;
-  static std::ostream &Infix(std::ostream &o) { return o << "**"; }
+  static const char *Infix() { return "**"; }
 };
 
 template<typename A> struct Extremum : public Operation<Extremum<A>, A, A, A> {
@@ -352,8 +351,8 @@ template<typename A> struct Extremum : public Operation<Extremum<A>, A, A, A> {
       Expr<Operand> &&x, Expr<Operand> &&y, Ordering ord = Ordering::Greater)
     : Base{std::move(x), std::move(y)}, ordering{ord} {}
 
-  std::ostream &Prefix(std::ostream &o) const {
-    return o << (ordering == Ordering::Less ? "MIN(" : "MAX(");
+  const char *Prefix() const {
+    return ordering == Ordering::Less ? "MIN(" : "MAX(";
   }
 
   Ordering ordering{Ordering::Greater};
@@ -379,7 +378,7 @@ struct Concat
   using Operand = Result;
   using Base = Operation<Concat, Result, Operand, Operand>;
   using Base::Base;
-  static std::ostream &Infix(std::ostream &o) { return o << "//"; }
+  static const char *Infix() { return "//"; }
 };
 
 ENUM_CLASS(LogicalOperator, And, Or, Eqv, Neqv)
@@ -398,7 +397,7 @@ struct LogicalOperation
   LogicalOperation(LogicalOperator opr, Expr<Operand> &&x, Expr<Operand> &&y)
     : Base{std::move(x), std::move(y)}, logicalOperator{opr} {}
 
-  std::ostream &Infix(std::ostream &) const;
+  const char *Infix() const;
 
   LogicalOperator logicalOperator;
 };
@@ -588,9 +587,9 @@ public:
   common::CombineVariants<Operations, Others> u;
 };
 
-FOR_EACH_INTEGER_KIND(extern template class Expr)
-FOR_EACH_REAL_KIND(extern template class Expr)
-FOR_EACH_COMPLEX_KIND(extern template class Expr)
+FOR_EACH_INTEGER_KIND(extern template class Expr)
+FOR_EACH_REAL_KIND(extern template class Expr)
+FOR_EACH_COMPLEX_KIND(extern template class Expr)
 
 template<int KIND>
 class Expr<Type<TypeCategory::Character, KIND>>
@@ -609,7 +608,7 @@ public:
       u;
 };
 
-FOR_EACH_CHARACTER_KIND(extern template class Expr)
+FOR_EACH_CHARACTER_KIND(extern template class Expr)
 
 // The Relational class template is a helper for constructing logical
 // expressions with polymorphism over the cross product of the possible
@@ -634,7 +633,7 @@ struct Relational : public Operation<Relational<A>, LogicalResult, A, A> {
   Relational(RelationalOperator r, Expr<Operand> &&a, Expr<Operand> &&b)
     : Base{std::move(a), std::move(b)}, opr{r} {}
 
-  std::ostream &Infix(std::ostream &) const;
+  const char *Infix() const;
 
   RelationalOperator opr;
 };
@@ -655,9 +654,9 @@ public:
   common::MapTemplate<Relational, DirectlyComparableTypes> u;
 };
 
-FOR_EACH_INTEGER_KIND(extern template struct Relational)
-FOR_EACH_REAL_KIND(extern template struct Relational)
-FOR_EACH_CHARACTER_KIND(extern template struct Relational)
+FOR_EACH_INTEGER_KIND(extern template struct Relational)
+FOR_EACH_REAL_KIND(extern template struct Relational)
+FOR_EACH_CHARACTER_KIND(extern template struct Relational)
 extern template struct Relational<SomeType>;
 
 // Logical expressions of a kind bigger than LogicalResult
@@ -686,7 +685,7 @@ public:
       u;
 };
 
-FOR_EACH_LOGICAL_KIND(extern template class Expr)
+FOR_EACH_LOGICAL_KIND(extern template class Expr)
 
 // StructureConstructor pairs a StructureConstructorValues instance
 // (a map associating symbols with expressions) with a derived type
@@ -823,9 +822,21 @@ struct GenericExprWrapper {
 std::ostream &DerivedTypeSpecAsFortran(
     std::ostream &, const semantics::DerivedTypeSpec &);
 
-FOR_EACH_CATEGORY_TYPE(extern template class Expr)
-FOR_EACH_TYPE_AND_KIND(extern template class ExpressionBase)
-FOR_EACH_INTRINSIC_KIND(extern template class ArrayConstructorValues)
-FOR_EACH_INTRINSIC_KIND(extern template class ArrayConstructor)
+FOR_EACH_CATEGORY_TYPE(extern template class Expr, )
+FOR_EACH_TYPE_AND_KIND(extern template class ExpressionBase, )
+FOR_EACH_INTRINSIC_KIND(extern template class ArrayConstructorValues, )
+FOR_EACH_INTRINSIC_KIND(extern template class ArrayConstructor, )
+
+// Template instantiations to resolve these "extern template" declarations.
+#define INSTANTIATE_EXPRESSION_TEMPLATES \
+  FOR_EACH_INTRINSIC_KIND(template class Expr, ) \
+  FOR_EACH_CATEGORY_TYPE(template class Expr, ) \
+  FOR_EACH_INTEGER_KIND(template struct Relational, ) \
+  FOR_EACH_REAL_KIND(template struct Relational, ) \
+  FOR_EACH_CHARACTER_KIND(template struct Relational, ) \
+  template struct Relational<SomeType>; \
+  FOR_EACH_TYPE_AND_KIND(template class ExpressionBase, ) \
+  FOR_EACH_INTRINSIC_KIND(template class ArrayConstructorValues, ) \
+  FOR_EACH_INTRINSIC_KIND(template class ArrayConstructor, )
 }
 #endif  // FORTRAN_EVALUATE_EXPRESSION_H_
index 9da28c9..9270415 100644 (file)
@@ -1355,7 +1355,7 @@ Expr<T> ExpressionBase<T>::Rewrite(FoldingContext &context, Expr<T> &&expr) {
       std::move(expr.u));
 }
 
-FOR_EACH_TYPE_AND_KIND(template class ExpressionBase)
+FOR_EACH_TYPE_AND_KIND(template class ExpressionBase)
 
 // Constant expression predicate IsConstantExpr().
 // This code determines whether an expression is a "constant expression"
diff --git a/flang/lib/evaluate/formatting.cc b/flang/lib/evaluate/formatting.cc
new file mode 100644 (file)
index 0000000..c638578
--- /dev/null
@@ -0,0 +1,390 @@
+// Copyright (c) 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.
+// 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 "formatting.h"
+#include "call.h"
+#include "constant.h"
+#include "expression.h"
+#include "../parser/characters.h"
+#include "../semantics/symbol.h"
+
+namespace Fortran::evaluate {
+
+static void ShapeAsFortran(
+    std::ostream &o, const std::vector<std::int64_t> &shape) {
+  if (shape.size() > 1) {
+    o << ",shape=";
+    char ch{'['};
+    for (auto dim : shape) {
+      o << ch << dim;
+      ch = ',';
+    }
+    o << "])";
+  }
+}
+
+template<typename RESULT, typename VALUE>
+std::ostream &ConstantBase<RESULT, VALUE>::AsFortran(std::ostream &o) const {
+  if (Rank() > 1) {
+    o << "reshape(";
+  }
+  if (Rank() > 0) {
+    o << '[' << GetType().AsFortran() << "::";
+  }
+  bool first{true};
+  for (const auto &value : values_) {
+    if (first) {
+      first = false;
+    } else {
+      o << ',';
+    }
+    if constexpr (Result::category == TypeCategory::Integer) {
+      o << value.SignedDecimal() << '_' << Result::kind;
+    } else if constexpr (Result::category == TypeCategory::Real ||
+        Result::category == TypeCategory::Complex) {
+      value.AsFortran(o, Result::kind);
+    } else if constexpr (Result::category == TypeCategory::Character) {
+      o << Result::kind << '_' << parser::QuoteCharacterLiteral(value);
+    } else if constexpr (Result::category == TypeCategory::Logical) {
+      if (value.IsTrue()) {
+        o << ".true.";
+      } else {
+        o << ".false.";
+      }
+      o << '_' << Result::kind;
+    } else {
+      StructureConstructor{AsConstant().derivedTypeSpec(), value}.AsFortran(o);
+    }
+  }
+  if (Rank() > 0) {
+    o << ']';
+  }
+  ShapeAsFortran(o, shape_);
+  return o;
+}
+
+template<int KIND>
+std::ostream &Constant<Type<TypeCategory::Character, KIND>>::AsFortran(
+    std::ostream &o) const {
+  if (Rank() > 1) {
+    o << "reshape(";
+  }
+  if (Rank() > 0) {
+    o << '[' << GetType().AsFortran(std::to_string(length_)) << "::";
+  }
+  auto total{static_cast<std::int64_t>(size())};
+  for (std::int64_t j{0}; j < total; ++j) {
+    ScalarValue value{values_.substr(j * length_, length_)};
+    if (j > 0) {
+      o << ',';
+    } else if (Rank() == 0) {
+      o << Result::kind << '_';
+    }
+    o << parser::QuoteCharacterLiteral(value);
+  }
+  if (Rank() > 0) {
+    o << ']';
+  }
+  ShapeAsFortran(o, shape_);
+  return o;
+}
+
+std::ostream &ActualArgument::AsFortran(std::ostream &o) const {
+  if (keyword.has_value()) {
+    o << keyword->ToString() << '=';
+  }
+  if (isAlternateReturn) {
+    o << '*';
+  }
+  return value().AsFortran(o);
+}
+
+std::ostream &SpecificIntrinsic::AsFortran(std::ostream &o) const {
+  return o << name;
+}
+
+std::ostream &ProcedureRef::AsFortran(std::ostream &o) const {
+  proc_.AsFortran(o);
+  char separator{'('};
+  for (const auto &arg : arguments_) {
+    if (arg.has_value()) {
+      arg->AsFortran(o << separator);
+      separator = ',';
+    }
+  }
+  if (separator == '(') {
+    o << '(';
+  }
+  return o << ')';
+}
+
+// Operator precedence formatting; insert parentheses around operands
+// only when necessary.
+
+enum class Precedence {
+  Primary,  // don't parenthesize
+  Parenthesize,  // (x), (real, imaginary)
+  DefinedUnary,
+  Negate,
+  Power,  // ** which is right-associative
+  Multiplicative,  // *, /
+  Additive,  // +, -, //
+  Relational,
+  Logical,  // .OR., .AND., .EQV., .NEQV.
+  NOT,  // yes, this binds less tightly in Fortran than .OR./.AND./&c. do
+  DefinedBinary
+};
+
+template<typename A> constexpr Precedence ToPrecedence{Precedence::Primary};
+
+template<typename T>
+constexpr Precedence ToPrecedence<Parentheses<T>>{Precedence::Parenthesize};
+template<int KIND>
+constexpr Precedence ToPrecedence<ComplexConstructor<KIND>>{
+    Precedence::Parenthesize};
+template<typename T>
+constexpr Precedence ToPrecedence<Negate<T>>{Precedence::Negate};
+template<typename T>
+constexpr Precedence ToPrecedence<Power<T>>{Precedence::Power};
+template<typename T>
+constexpr Precedence ToPrecedence<RealToIntPower<T>>{Precedence::Power};
+template<typename T>
+constexpr Precedence ToPrecedence<Multiply<T>>{Precedence::Multiplicative};
+template<typename T>
+constexpr Precedence ToPrecedence<Divide<T>>{Precedence::Multiplicative};
+template<typename T>
+constexpr Precedence ToPrecedence<Add<T>>{Precedence::Additive};
+template<typename T>
+constexpr Precedence ToPrecedence<Subtract<T>>{Precedence::Additive};
+template<int KIND>
+constexpr Precedence ToPrecedence<Concat<KIND>>{Precedence::Additive};
+template<typename T>
+constexpr Precedence ToPrecedence<Relational<T>>{Precedence::Relational};
+template<int KIND>
+constexpr Precedence ToPrecedence<LogicalOperation<KIND>>{Precedence::Logical};
+template<int KIND>
+constexpr Precedence ToPrecedence<Not<KIND>>{Precedence::NOT};
+
+template<typename T>
+static constexpr Precedence GetPrecedence(const Expr<T> &expr) {
+  return std::visit(
+      [](const auto &x) { return ToPrecedence<std::decay_t<decltype(x)>>; },
+      expr.u);
+}
+template<TypeCategory CAT>
+static constexpr Precedence GetPrecedence(const Expr<SomeKind<CAT>> &expr) {
+  return std::visit([](const auto &x) { return GetPrecedence(x); }, expr.u);
+}
+static constexpr Precedence GetPrecedence(const Expr<SomeDerived> &expr) {
+  return std::visit(
+      [](const auto &x) { return ToPrecedence<std::decay_t<decltype(x)>>; },
+      expr.u);
+}
+static constexpr Precedence GetPrecedence(const Expr<SomeType> &expr) {
+  return std::visit(
+      common::visitors{
+          [](const BOZLiteralConstant &) { return Precedence::Primary; },
+          [](const NullPointer &) { return Precedence::Primary; },
+          [](const auto &x) { return GetPrecedence(x); },
+      },
+      expr.u);
+}
+
+template<typename D, typename R, typename... O>
+std::ostream &Operation<D, R, O...>::AsFortran(std::ostream &o) const {
+  static constexpr Precedence lhsPrec{ToPrecedence<Operand<0>>};
+  o << derived().Prefix();
+  if constexpr (operands == 1) {
+    bool parens{lhsPrec != Precedence::Primary};
+    if (parens) {
+      o << '(';
+    }
+    o << left();
+    if (parens) {
+      o << ')';
+    }
+  } else {
+    static constexpr Precedence thisPrec{ToPrecedence<D>};
+    bool lhsParens{lhsPrec == Precedence::Parenthesize || lhsPrec > thisPrec ||
+        (lhsPrec == thisPrec && lhsPrec == Precedence::Power)};
+    if (lhsParens) {
+      o << '(';
+    }
+    o << left();
+    if (lhsParens) {
+      o << ')';
+    }
+    static constexpr Precedence rhsPrec{ToPrecedence<Operand<1>>};
+    bool rhsParens{rhsPrec == Precedence::Parenthesize || rhsPrec > thisPrec};
+    if (rhsParens) {
+      o << '(';
+    }
+    o << derived().Infix() << right();
+    if (rhsParens) {
+      o << ')';
+    }
+  }
+  return o << derived().Suffix();
+}
+
+template<typename TO, TypeCategory FROMCAT>
+std::ostream &Convert<TO, FROMCAT>::AsFortran(std::ostream &o) const {
+  static_assert(TO::category == TypeCategory::Integer ||
+      TO::category == TypeCategory::Real ||
+      TO::category == TypeCategory::Character ||
+      TO::category == TypeCategory::Logical || !"Convert<> to bad category!");
+  if constexpr (TO::category == TypeCategory::Character) {
+    this->left().AsFortran(o << "achar(iachar(") << ')';
+  } else if constexpr (TO::category == TypeCategory::Integer) {
+    this->left().AsFortran(o << "int(");
+  } else if constexpr (TO::category == TypeCategory::Real) {
+    this->left().AsFortran(o << "real(");
+  } else {
+    this->left().AsFortran(o << "logical(");
+  }
+  return o << ",kind=" << TO::kind << ')';
+}
+
+template<typename A> const char *Relational<A>::Infix() const {
+  switch (opr) {
+  case RelationalOperator::LT: return "<";
+  case RelationalOperator::LE: return "<=";
+  case RelationalOperator::EQ: return "==";
+  case RelationalOperator::NE: return "/=";
+  case RelationalOperator::GE: return ">=";
+  case RelationalOperator::GT: return ">";
+  }
+  return nullptr;
+}
+
+std::ostream &Relational<SomeType>::AsFortran(std::ostream &o) const {
+  std::visit([&](const auto &rel) { rel.AsFortran(o); }, u);
+  return o;
+}
+
+template<int KIND> const char *LogicalOperation<KIND>::Infix() const {
+  switch (logicalOperator) {
+  case LogicalOperator::And: return ".and.";
+  case LogicalOperator::Or: return ".or.";
+  case LogicalOperator::Eqv: return ".eqv.";
+  case LogicalOperator::Neqv: return ".neqv.";
+  }
+  return nullptr;
+}
+
+template<typename T>
+std::ostream &Emit(
+    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> &);
+
+template<typename T>
+std::ostream &Emit(std::ostream &o, const ImpliedDo<T> &implDo) {
+  o << '(';
+  Emit(o, implDo.values());
+  o << ',' << ImpliedDoIndex::Result::AsFortran()
+    << "::" << implDo.name().ToString() << '=';
+  implDo.lower().AsFortran(o) << ',';
+  implDo.upper().AsFortran(o) << ',';
+  implDo.stride().AsFortran(o) << ')';
+  return o;
+}
+
+template<typename T>
+std::ostream &Emit(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);
+    sep = ",";
+  }
+  return o;
+}
+
+template<typename T>
+std::ostream &ArrayConstructor<T>::AsFortran(std::ostream &o) const {
+  o << '[' << GetType().AsFortran() << "::";
+  Emit(o, *this);
+  return o << ']';
+}
+
+template<int KIND>
+std::ostream &ArrayConstructor<Type<TypeCategory::Character, KIND>>::AsFortran(
+    std::ostream &o) const {
+  std::stringstream len;
+  LEN().AsFortran(len);
+  o << '[' << GetType().AsFortran(len.str()) << "::";
+  Emit(o, *this);
+  return o << ']';
+}
+
+std::ostream &ArrayConstructor<SomeDerived>::AsFortran(std::ostream &o) const {
+  o << '[' << GetType().AsFortran() << "::";
+  Emit(o, *this);
+  return o << ']';
+}
+
+template<typename RESULT>
+std::ostream &ExpressionBase<RESULT>::AsFortran(std::ostream &o) const {
+  std::visit(
+      common::visitors{
+          [&](const BOZLiteralConstant &x) {
+            o << "z'" << x.Hexadecimal() << "'";
+          },
+          [&](const NullPointer &) { o << "NULL()"; },
+          [&](const common::CopyableIndirection<Substring> &s) {
+            s.value().AsFortran(o);
+          },
+          [&](const ImpliedDoIndex &i) { o << i.name.ToString(); },
+          [&](const auto &x) { x.AsFortran(o); },
+      },
+      derived().u);
+  return o;
+}
+
+std::ostream &StructureConstructor::AsFortran(std::ostream &o) const {
+  DerivedTypeSpecAsFortran(o, *derivedTypeSpec_);
+  if (values_.empty()) {
+    o << '(';
+  } else {
+    char ch{'('};
+    for (const auto &[symbol, value] : values_) {
+      value.value().AsFortran(o << ch << symbol->name().ToString() << '=');
+      ch = ',';
+    }
+  }
+  return o << ')';
+}
+
+std::ostream &DerivedTypeSpecAsFortran(
+    std::ostream &o, const semantics::DerivedTypeSpec &spec) {
+  o << spec.typeSymbol().name().ToString();
+  if (!spec.parameters().empty()) {
+    char ch{'('};
+    for (const auto &[name, value] : spec.parameters()) {
+      value.GetExplicit()->AsFortran(o << ch << name.ToString() << '=');
+      ch = ',';
+    }
+    o << ')';
+  }
+  return o;
+}
+
+INSTANTIATE_CONSTANT_TEMPLATES
+INSTANTIATE_EXPRESSION_TEMPLATES
+// TODO variable templates and call templates?
+}
diff --git a/flang/lib/evaluate/formatting.h b/flang/lib/evaluate/formatting.h
new file mode 100644 (file)
index 0000000..21dd0fe
--- /dev/null
@@ -0,0 +1,46 @@
+// Copyright (c) 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.
+// 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_EVALUATE_FORMATTING_H_
+#define FORTRAN_EVALUATE_FORMATTING_H_
+
+#include "../common/indirection.h"
+#include <optional>
+#include <ostream>
+#include <type_traits>
+
+namespace Fortran::evaluate {
+
+template<typename A>
+auto operator<<(std::ostream &o, const A &x) -> decltype(x.AsFortran(o)) {
+  return x.AsFortran(o);
+}
+
+template<typename A, bool COPYABLE>
+auto operator<<(
+    std::ostream &o, const Fortran::common::Indirection<A, COPYABLE> &x)
+    -> decltype(o << x.value()) {
+  return o << x.value();
+}
+
+template<typename A>
+auto operator<<(std::ostream &o, const std::optional<A> &x)
+    -> decltype(o << *x) {
+  if (x.has_value()) {
+    o << *x;
+  }
+  return o;
+}
+}
+#endif  // FORTRAN_EVALUATE_FORMATTING_H_
index 27ece24..591e69a 100644 (file)
@@ -16,6 +16,7 @@
 #define FORTRAN_EVALUATE_REAL_H_
 
 #include "common.h"
+#include "formatting.h"
 #include "integer.h"
 #include "rounding-bits.h"
 #include <cinttypes>
index 118bd38..6c8bf52 100644 (file)
@@ -17,6 +17,7 @@
 
 // Represents constant static data objects
 
+#include "formatting.h"
 #include "type.h"
 #include "../common/idioms.h"
 #include <cinttypes>
index 1bdd396..7d6fff0 100644 (file)
@@ -24,6 +24,7 @@
 
 #include "common.h"
 #include "complex.h"
+#include "formatting.h"
 #include "integer.h"
 #include "logical.h"
 #include "real.h"
@@ -317,58 +318,60 @@ template<typename CONST> struct TypeOfHelper {
 template<typename CONST> using TypeOf = typename TypeOfHelper<CONST>::type;
 
 // For generating "[extern] template class", &c. boilerplate
-#define EXPAND_FOR_EACH_INTEGER_KIND(M, P) \
-  M(P, 1) M(P, 2) M(P, 4) M(P, 8) M(P, 16)
-#define EXPAND_FOR_EACH_REAL_KIND(M, P) \
-  M(P, 2) M(P, 3) M(P, 4) M(P, 8) M(P, 10) M(P, 16)
-#define EXPAND_FOR_EACH_COMPLEX_KIND(M, P) EXPAND_FOR_EACH_REAL_KIND(M, P)
-#define EXPAND_FOR_EACH_CHARACTER_KIND(M, P) M(P, 1) M(P, 2) M(P, 4)
-#define EXPAND_FOR_EACH_LOGICAL_KIND(M, P) M(P, 1) M(P, 2) M(P, 4) M(P, 8)
-#define TEMPLATE_INSTANTIATION(P, ARG) P<ARG>;
-
-#define FOR_EACH_INTEGER_KIND_HELP(PREFIX, K) \
-  PREFIX<Type<TypeCategory::Integer, K>>;
-#define FOR_EACH_REAL_KIND_HELP(PREFIX, K) PREFIX<Type<TypeCategory::Real, K>>;
-#define FOR_EACH_COMPLEX_KIND_HELP(PREFIX, K) \
-  PREFIX<Type<TypeCategory::Complex, K>>;
-#define FOR_EACH_CHARACTER_KIND_HELP(PREFIX, K) \
-  PREFIX<Type<TypeCategory::Character, K>>;
-#define FOR_EACH_LOGICAL_KIND_HELP(PREFIX, K) \
-  PREFIX<Type<TypeCategory::Logical, K>>;
-
-#define FOR_EACH_INTEGER_KIND(PREFIX) \
-  EXPAND_FOR_EACH_INTEGER_KIND(FOR_EACH_INTEGER_KIND_HELP, PREFIX)
-#define FOR_EACH_REAL_KIND(PREFIX) \
-  EXPAND_FOR_EACH_REAL_KIND(FOR_EACH_REAL_KIND_HELP, PREFIX)
-#define FOR_EACH_COMPLEX_KIND(PREFIX) \
-  EXPAND_FOR_EACH_COMPLEX_KIND(FOR_EACH_COMPLEX_KIND_HELP, PREFIX)
-#define FOR_EACH_CHARACTER_KIND(PREFIX) \
-  EXPAND_FOR_EACH_CHARACTER_KIND(FOR_EACH_CHARACTER_KIND_HELP, PREFIX)
-#define FOR_EACH_LOGICAL_KIND(PREFIX) \
-  EXPAND_FOR_EACH_LOGICAL_KIND(FOR_EACH_LOGICAL_KIND_HELP, PREFIX)
-
-#define FOR_EACH_LENGTHLESS_INTRINSIC_KIND(PREFIX) \
-  FOR_EACH_INTEGER_KIND(PREFIX) \
-  FOR_EACH_REAL_KIND(PREFIX) \
-  FOR_EACH_COMPLEX_KIND(PREFIX) \
-  FOR_EACH_LOGICAL_KIND(PREFIX)
-#define FOR_EACH_INTRINSIC_KIND(PREFIX) \
-  FOR_EACH_LENGTHLESS_INTRINSIC_KIND(PREFIX) \
-  FOR_EACH_CHARACTER_KIND(PREFIX)
-#define FOR_EACH_SPECIFIC_TYPE(PREFIX) \
-  FOR_EACH_INTRINSIC_KIND(PREFIX) \
-  PREFIX<SomeDerived>;
-
-#define FOR_EACH_CATEGORY_TYPE(PREFIX) \
-  PREFIX<SomeInteger>; \
-  PREFIX<SomeReal>; \
-  PREFIX<SomeComplex>; \
-  PREFIX<SomeCharacter>; \
-  PREFIX<SomeLogical>; \
-  PREFIX<SomeDerived>; \
-  PREFIX<SomeType>;
-#define FOR_EACH_TYPE_AND_KIND(PREFIX) \
-  FOR_EACH_INTRINSIC_KIND(PREFIX) \
-  FOR_EACH_CATEGORY_TYPE(PREFIX)
+#define EXPAND_FOR_EACH_INTEGER_KIND(M, P, S) \
+  M(P, S, 1) M(P, S, 2) M(P, S, 4) M(P, S, 8) M(P, S, 16)
+#define EXPAND_FOR_EACH_REAL_KIND(M, P, S) \
+  M(P, S, 2) M(P, S, 3) M(P, S, 4) M(P, S, 8) M(P, S, 10) M(P, S, 16)
+#define EXPAND_FOR_EACH_COMPLEX_KIND(M, P, S) EXPAND_FOR_EACH_REAL_KIND(M, P, S)
+#define EXPAND_FOR_EACH_CHARACTER_KIND(M, P, S) M(P, S, 1) M(P, S, 2) M(P, S, 4)
+#define EXPAND_FOR_EACH_LOGICAL_KIND(M, P, S) \
+  M(P, S, 1) M(P, S, 2) M(P, S, 4) M(P, S, 8)
+#define TEMPLATE_INSTANTIATION(P, S, ARG) P<ARG> S;
+
+#define FOR_EACH_INTEGER_KIND_HELP(PREFIX, SUFFIX, K) \
+  PREFIX<Type<TypeCategory::Integer, K>> SUFFIX;
+#define FOR_EACH_REAL_KIND_HELP(PREFIX, SUFFIX, K) \
+  PREFIX<Type<TypeCategory::Real, K>> SUFFIX;
+#define FOR_EACH_COMPLEX_KIND_HELP(PREFIX, SUFFIX, K) \
+  PREFIX<Type<TypeCategory::Complex, K>> SUFFIX;
+#define FOR_EACH_CHARACTER_KIND_HELP(PREFIX, SUFFIX, K) \
+  PREFIX<Type<TypeCategory::Character, K>> SUFFIX;
+#define FOR_EACH_LOGICAL_KIND_HELP(PREFIX, SUFFIX, K) \
+  PREFIX<Type<TypeCategory::Logical, K>> SUFFIX;
+
+#define FOR_EACH_INTEGER_KIND(PREFIX, SUFFIX) \
+  EXPAND_FOR_EACH_INTEGER_KIND(FOR_EACH_INTEGER_KIND_HELP, PREFIX, SUFFIX)
+#define FOR_EACH_REAL_KIND(PREFIX, SUFFIX) \
+  EXPAND_FOR_EACH_REAL_KIND(FOR_EACH_REAL_KIND_HELP, PREFIX, SUFFIX)
+#define FOR_EACH_COMPLEX_KIND(PREFIX, SUFFIX) \
+  EXPAND_FOR_EACH_COMPLEX_KIND(FOR_EACH_COMPLEX_KIND_HELP, PREFIX, SUFFIX)
+#define FOR_EACH_CHARACTER_KIND(PREFIX, SUFFIX) \
+  EXPAND_FOR_EACH_CHARACTER_KIND(FOR_EACH_CHARACTER_KIND_HELP, PREFIX, SUFFIX)
+#define FOR_EACH_LOGICAL_KIND(PREFIX, SUFFIX) \
+  EXPAND_FOR_EACH_LOGICAL_KIND(FOR_EACH_LOGICAL_KIND_HELP, PREFIX, SUFFIX)
+
+#define FOR_EACH_LENGTHLESS_INTRINSIC_KIND(PREFIX, SUFFIX) \
+  FOR_EACH_INTEGER_KIND(PREFIX, SUFFIX) \
+  FOR_EACH_REAL_KIND(PREFIX, SUFFIX) \
+  FOR_EACH_COMPLEX_KIND(PREFIX, SUFFIX) \
+  FOR_EACH_LOGICAL_KIND(PREFIX, SUFFIX)
+#define FOR_EACH_INTRINSIC_KIND(PREFIX, SUFFIX) \
+  FOR_EACH_LENGTHLESS_INTRINSIC_KIND(PREFIX, SUFFIX) \
+  FOR_EACH_CHARACTER_KIND(PREFIX, SUFFIX)
+#define FOR_EACH_SPECIFIC_TYPE(PREFIX, SUFFIX) \
+  FOR_EACH_INTRINSIC_KIND(PREFIX, SUFFIX) \
+  PREFIX<SomeDerived> SUFFIX;
+
+#define FOR_EACH_CATEGORY_TYPE(PREFIX, SUFFIX) \
+  PREFIX<SomeInteger> SUFFIX; \
+  PREFIX<SomeReal> SUFFIX; \
+  PREFIX<SomeComplex> SUFFIX; \
+  PREFIX<SomeCharacter> SUFFIX; \
+  PREFIX<SomeLogical> SUFFIX; \
+  PREFIX<SomeDerived> SUFFIX; \
+  PREFIX<SomeType> SUFFIX;
+#define FOR_EACH_TYPE_AND_KIND(PREFIX, SUFFIX) \
+  FOR_EACH_INTRINSIC_KIND(PREFIX, SUFFIX) \
+  FOR_EACH_CATEGORY_TYPE(PREFIX, SUFFIX)
 }
 #endif  // FORTRAN_EVALUATE_TYPE_H_
index ecdbbd3..8fa75e9 100644 (file)
@@ -684,6 +684,6 @@ bool ProcedureRef::operator==(const ProcedureRef &that) const {
 }
 
 EXPAND_FOR_EACH_INTEGER_KIND(
-    TEMPLATE_INSTANTIATION, template class TypeParamInquiry)
-FOR_EACH_SPECIFIC_TYPE(template class Designator)
+    TEMPLATE_INSTANTIATION, template class TypeParamInquiry)
+FOR_EACH_SPECIFIC_TYPE(template class Designator)
 }
index 28f3ac8..8a946e8 100644 (file)
@@ -23,6 +23,7 @@
 
 #include "call.h"
 #include "common.h"
+#include "formatting.h"
 #include "static-data.h"
 #include "type.h"
 #include "../common/idioms.h"
@@ -129,7 +130,7 @@ private:
 };
 
 EXPAND_FOR_EACH_INTEGER_KIND(
-    TEMPLATE_INSTANTIATION, extern template class TypeParamInquiry)
+    TEMPLATE_INSTANTIATION, extern template class TypeParamInquiry)
 
 // R921 subscript-triplet
 class Triplet {
@@ -354,7 +355,7 @@ public:
   Variant u;
 };
 
-FOR_EACH_CHARACTER_KIND(extern template class Designator)
+FOR_EACH_CHARACTER_KIND(extern template class Designator)
 
 template<typename T> struct Variable {
   using Result = T;
index ffa522a..5901b92 100644 (file)
@@ -437,13 +437,13 @@ void PutTypeParam(std::ostream &os, const Symbol &symbol) {
 
 void PutInit(std::ostream &os, const MaybeExpr &init) {
   if (init) {
-    init->AsFortran(os << '=');
+    os << '=' << init;
   }
 }
 
 void PutInit(std::ostream &os, const MaybeIntExpr &init) {
   if (init) {
-    init->AsFortran(os << '=');
+    os << '=' << init;
   }
 }
 
@@ -453,7 +453,7 @@ void PutBound(std::ostream &os, const Bound &x) {
   } else if (x.isDeferred()) {
     os << ':';
   } else {
-    x.GetExplicit()->AsFortran(os);
+    os << x.GetExplicit();
   }
 }
 
@@ -482,7 +482,7 @@ std::ostream &PutAttrs(std::ostream &os, Attrs attrs, const MaybeExpr &bindName,
   attrs.set(Attr::PUBLIC, false);  // no need to write PUBLIC
   attrs.set(Attr::EXTERNAL, false);  // no need to write EXTERNAL
   if (bindName) {
-    bindName->AsFortran(os << before << "bind(c, name=") << ')' << after;
+    os << before << "bind(c, name=" << bindName << ')' << after;
     attrs.set(Attr::BIND_C, false);
   }
   for (std::size_t i{0}; i < Attr_enumSize; ++i) {
index 16c57b5..34189b2 100644 (file)
@@ -53,7 +53,7 @@ std::ostream &operator<<(std::ostream &os, const SubprogramDetails &x) {
     os << " isInterface";
   }
   if (x.bindName_) {
-    x.bindName_->AsFortran(os << " bindName:");
+    os << " bindName:" << x.bindName_;
   }
   if (x.result_) {
     os << " result:" << x.result_.value()->name();
@@ -275,7 +275,7 @@ std::ostream &operator<<(std::ostream &os, const EntityDetails &x) {
     os << " type: " << *x.type();
   }
   if (x.bindName_) {
-    x.bindName_->AsFortran(os << " bindName:");
+    os << " bindName:" << x.bindName_;
   }
   return os;
 }
@@ -289,7 +289,7 @@ std::ostream &operator<<(std::ostream &os, const ObjectEntityDetails &x) {
     }
   }
   if (x.init_) {
-    x.init_->AsFortran(os << " init:");
+    os << " init:" << x.init_;
   }
   return os;
 }
@@ -297,7 +297,7 @@ std::ostream &operator<<(std::ostream &os, const ObjectEntityDetails &x) {
 std::ostream &operator<<(std::ostream &os, const AssocEntityDetails &x) {
   os << *static_cast<const EntityDetails *>(&x);
   if (x.expr().has_value()) {
-    x.expr()->AsFortran(os << ' ');
+    os << ' ' << x.expr();
   }
   return os;
 }
@@ -309,7 +309,7 @@ std::ostream &operator<<(std::ostream &os, const ProcEntityDetails &x) {
     os << ' ' << *type;
   }
   if (x.bindName()) {
-    x.bindName()->AsFortran(os << " bindName:");
+    os << " bindName:" << x.bindName();
   }
   if (x.passName_) {
     os << " passName:" << *x.passName_;
@@ -369,7 +369,7 @@ std::ostream &operator<<(std::ostream &os, const Details &details) {
             }
             os << ')';
             if (x.bindName()) {
-              x.bindName()->AsFortran(os << " bindName:");
+              os << " bindName:" << x.bindName();
             }
             if (x.isFunction()) {
               os << " result(";
@@ -432,7 +432,7 @@ std::ostream &operator<<(std::ostream &os, const Details &details) {
             }
             os << ' ' << common::EnumToString(x.attr());
             if (x.init()) {
-              x.init()->AsFortran(os << " init:");
+              os << " init:" << x.init();
             }
           },
           [&](const MiscDetails &x) {
index 808674b..826fcb2 100644 (file)
@@ -101,7 +101,7 @@ void DerivedTypeSpec::Instantiate(
             maybeDynamicType->category == TypeCategory::Integer &&
             !evaluate::ToInt64(expr).has_value()) {
           std::stringstream fortran;
-          expr->AsFortran(fortran);
+          fortran << expr;
           if (auto *msg{foldingContext.messages().Say(
                   "Value of kind type parameter '%s' (%s) is not "
                   "scalar INTEGER constant"_err_en_US,
@@ -168,7 +168,7 @@ std::ostream &operator<<(std::ostream &o, const Bound &x) {
   } else if (x.isDeferred()) {
     o << ':';
   } else if (x.expr_) {
-    x.expr_->AsFortran(o);
+    o << x.expr_;
   } else {
     o << "<no-expr>";
   }
@@ -231,7 +231,7 @@ std::ostream &operator<<(std::ostream &o, const ParamValue &x) {
   } else if (!x.GetExplicit()) {
     o << "<no-expr>";
   } else {
-    x.GetExplicit()->AsFortran(o);
+    o << x.GetExplicit();
   }
   return o;
 }
@@ -246,7 +246,7 @@ std::ostream &operator<<(std::ostream &os, const IntrinsicTypeSpec &x) {
   if (auto k{evaluate::ToInt64(x.kind())}) {
     return os << '(' << *k << ')';  // emit unsuffixed kind code
   } else {
-    return x.kind().AsFortran(os << '(') << ')';
+    return os << '(' << x.kind() << ')';
   }
 }
 
@@ -255,7 +255,7 @@ std::ostream &operator<<(std::ostream &os, const CharacterTypeSpec &x) {
   if (auto k{evaluate::ToInt64(x.kind())}) {
     return os << *k << ')';  // emit unsuffixed kind code
   } else {
-    return x.kind().AsFortran(os) << ')';
+    return os << x.kind() << ')';
   }
 }