[flang] support Constant arrays

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

flang/lib/evaluate/CMakeLists.txt

@@ -16,6 +16,7 @@ add_library(FortranEvaluate
   call.cc
   common.cc
   complex.cc
+  constant.cc
   decimal.cc
   expression.cc
   fold.cc

flang/lib/evaluate/constant.cc

@@ -0,0 +1,66 @@
+// 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 "constant.h"
+#include "type.h"
+#include "../parser/characters.h"
+
+namespace Fortran::evaluate {
+template<typename T>
+std::ostream &Constant<T>::AsFortran(std::ostream &o) const {
+  if (Rank() > 0) {
+    o << "reshape([" << GetType().AsFortran() << "::";
+  }
+  for (const auto &value : values_) {
+    if constexpr (T::category == TypeCategory::Integer) {
+      o << value.SignedDecimal() << '_' << T::kind;
+    } else if constexpr (T::category == TypeCategory::Real ||
+        T::category == TypeCategory::Complex) {
+      value.AsFortran(o, T::kind);
+    } else if constexpr (T::category == TypeCategory::Character) {
+      o << T::kind << '_' << parser::QuoteCharacterLiteral(value);
+    } else if constexpr (T::category == TypeCategory::Logical) {
+      if (value.IsTrue()) {
+        o << ".true.";
+      } else {
+        o << ".false.";
+      }
+      o << '_' << Result::kind;
+    } else {
+      value.u.AsFortran(o);
+    }
+  }
+  if (Rank() > 0) {
+    o << "],shape=";
+    char ch{'['};
+    for (auto dim : shape_) {
+      o << ch << dim;
+      ch = ',';
+    }
+    o << "])";
+  }
+  return o;
+}
+
+template<typename T> Constant<SubscriptInteger> Constant<T>::SHAPE() const {
+  using IntType = Scalar<SubscriptInteger>;
+  std::vector<IntType> result;
+  for (std::int64_t dim : shape_) {
+    result.emplace_back(dim);
+  }
+  return {std::move(result), std::vector<std::int64_t>{Rank()}};
+}
+
+FOR_EACH_INTRINSIC_KIND(template class Constant)
+}

flang/lib/evaluate/constant.h

@@ -0,0 +1,87 @@
+// 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_CONSTANT_H_
+#define FORTRAN_EVALUATE_CONSTANT_H_
+
+#include "type.h"
+#include <ostream>
+
+namespace Fortran::evaluate {
+// Wraps a constant value in a class templated by its resolved type.
+// N.B. Generic constants are represented by generic expressions
+// (like Expr<SomeInteger> & Expr<SomeType>) wrapping the appropriate
+// instantiations of Constant.
+template<typename T> class Constant {
+  static_assert(std::is_same_v<T, SomeDerived> || IsSpecificIntrinsicType<T>);
+
+public:
+  using Result = T;
+  using Value = Scalar<Result>;
+
+  CLASS_BOILERPLATE(Constant)
+  template<typename A> Constant(const A &x) : values_{x} {}
+  template<typename A>
+  Constant(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
+    : values_{std::move(x)} {}
+  Constant(std::vector<Value> &&x, std::vector<std::int64_t> &&s)
+    : values_(std::move(x)), shape_(std::move(s)) {}
+
+  constexpr DynamicType GetType() const { return Result::GetType(); }
+  int Rank() const { return static_cast<int>(shape_.size()); }
+  bool operator==(const Constant &that) const {
+    return shape_ == that.shape_ && values_ == that.values_;
+  }
+  std::size_t size() const { return values_.size(); }
+  const std::vector<std::int64_t> &shape() const { return shape_; }
+  std::int64_t LEN() const {
+    if constexpr (T::category != TypeCategory::Character) {
+      common::die("LEN() of non-character Constant");
+    } else if (values_.empty()) {
+      return 0;
+    } else {
+      return static_cast<std::int64_t>(values_[0].size());
+    }
+  }
+
+  const Value &operator*() const {
+    CHECK(values_.size() == 1);
+    return values_.at(0);
+  }
+
+  const Value &At(const std::vector<std::int64_t> &index) {
+    CHECK(index.size() == static_cast<std::size_t>(Rank()));
+    std::int64_t stride{1}, offset{0};
+    int dim{0};
+    for (std::int64_t j : index) {
+      std::int64_t bound{shape_[dim++]};
+      CHECK(j >= 1 && j <= bound);
+      offset += stride * (j - 1);
+      stride *= bound;
+    }
+    return values_.at(offset);
+  }
+
+  Constant<SubscriptInteger> SHAPE() const;
+  std::ostream &AsFortran(std::ostream &) const;
+
+private:
+  std::vector<Value> values_;
+  std::vector<std::int64_t> shape_;
+  // TODO pmk: make CHARACTER values contiguous
+};
+
+FOR_EACH_INTRINSIC_KIND(extern template class Constant)
+}
+#endif  // FORTRAN_EVALUATE_CONSTANT_H_

flang/lib/evaluate/expression.cc

@@ -1,4 +1,4 @@
-// Copyright (c) 2018, NVIDIA CORPORATION.  All rights reserved.
+// Copyright (c) 2018-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.
@@ -18,7 +18,6 @@
 #include "tools.h"
 #include "variable.h"
 #include "../common/idioms.h"
-#include "../parser/characters.h"
 #include "../parser/message.h"
 #include <ostream>
 #include <sstream>
@@ -83,27 +82,6 @@ std::ostream &LogicalOperation<KIND>::Infix(std::ostream &o) const {
   return o;
 }
 
-template<typename T>
-std::ostream &Constant<T>::AsFortran(std::ostream &o) const {
-  if constexpr (T::category == TypeCategory::Integer) {
-    return o << value.SignedDecimal() << '_' << T::kind;
-  } else if constexpr (T::category == TypeCategory::Real ||
-      T::category == TypeCategory::Complex) {
-    return value.AsFortran(o, T::kind);
-  } else if constexpr (T::category == TypeCategory::Character) {
-    return o << T::kind << '_' << parser::QuoteCharacterLiteral(value);
-  } else if constexpr (T::category == TypeCategory::Logical) {
-    if (value.IsTrue()) {
-      o << ".true.";
-    } else {
-      o << ".false.";
-    }
-    return o << '_' << Result::kind;
-  } else {
-    return value.u.AsFortran(o);
-  }
-}
-
 template<typename T>
 std::ostream &Emit(std::ostream &o, const CopyableIndirection<Expr<T>> &expr) {
   return expr->AsFortran(o);
@@ -172,7 +150,7 @@ Expr<SubscriptInteger> Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
   return std::visit(
       common::visitors{
           [](const Constant<Result> &c) {
-            return AsExpr(Constant<SubscriptInteger>{c.value.size()});
+            return AsExpr(Constant<SubscriptInteger>{c.LEN()});
           },
           [](const ArrayConstructor<Result> &a) { return a.LEN(); },
           [](const Parentheses<Result> &x) { return x.left().LEN(); },

flang/lib/evaluate/expression.h

@@ -23,6 +23,7 @@
 // for equality.
 
 #include "common.h"
+#include "constant.h"
 #include "type.h"
 #include "variable.h"
 #include "../lib/common/fortran.h"

flang/lib/evaluate/fold.h

@@ -19,6 +19,7 @@
 // evaluation.
 
 #include "common.h"
+#include "constant.h"
 #include "expression.h"
 #include "tools.h"
 #include "type.h"
@@ -51,7 +52,11 @@ std::optional<Expr<T>> Fold(
 template<typename T>
 const Scalar<T> *GetScalarConstantValue(const Expr<T> &expr) {
   if (const auto *c{UnwrapExpr<Constant<T>>(expr)}) {
-    return &c->value;
+    if (c->size() == 1) {
+      return &**c;
+    } else {
+      return nullptr;
+    }
   } else if (const auto *parens{UnwrapExpr<Parentheses<T>>(expr)}) {
     return GetScalarConstantValue<T>(parens->left());
   } else {

flang/lib/evaluate/tools.h

@@ -15,6 +15,7 @@
 #ifndef FORTRAN_EVALUATE_TOOLS_H_
 #define FORTRAN_EVALUATE_TOOLS_H_
 
+#include "constant.h"
 #include "expression.h"
 #include "../common/idioms.h"
 #include "../common/unwrap.h"

flang/lib/evaluate/type.h

@@ -1,4 +1,4 @@
-// Copyright (c) 2018, NVIDIA CORPORATION.  All rights reserved.
+// Copyright (c) 2018-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.
@@ -232,7 +232,7 @@ using AllIntrinsicTypes = common::CombineTuples<RelationalTypes, LogicalTypes>;
 using LengthlessIntrinsicTypes =
     common::CombineTuples<NumericTypes, LogicalTypes>;
 
-// Predicate: does a type represent a specific intrinsic type?
+// Predicates: does a type represent a specific intrinsic type?
 template<typename T>
 constexpr bool IsSpecificIntrinsicType{common::HasMember<T, AllIntrinsicTypes>};
 
@@ -352,29 +352,5 @@ struct SomeType {};
 #define FOR_EACH_TYPE_AND_KIND(PREFIX) \
   FOR_EACH_INTRINSIC_KIND(PREFIX) \
   FOR_EACH_CATEGORY_TYPE(PREFIX)
-
-// Wraps a constant scalar value of a specific intrinsic type
-// in a class with its resolved type.
-// N.B. Array constants are represented as array constructors
-// and derived type constants are structure constructors; generic
-// constants are generic expressions wrapping these constants.
-template<typename T> struct Constant {
-  static_assert(IsSpecificIntrinsicType<T>);
-  using Result = T;
-  using Value = Scalar<Result>;
-
-  CLASS_BOILERPLATE(Constant)
-  template<typename A> Constant(const A &x) : value{x} {}
-  template<typename A>
-  Constant(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
-    : value(std::move(x)) {}
-
-  constexpr DynamicType GetType() const { return Result::GetType(); }
-  int Rank() const { return 0; }
-  bool operator==(const Constant &that) const { return value == that.value; }
-  std::ostream &AsFortran(std::ostream &) const;
-
-  Value value;
-};
 }
 #endif  // FORTRAN_EVALUATE_TYPE_H_

flang/lib/evaluate/variable.h

@@ -25,6 +25,7 @@
 
 #include "call.h"
 #include "common.h"
+#include "constant.h"
 #include "static-data.h"
 #include "type.h"
 #include "../common/idioms.h"

flang/lib/semantics/expression.cc

@@ -890,10 +890,11 @@ static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context,
             using Result = ResultType<decltype(ckExpr)>;
             auto *cp{std::get_if<Constant<Result>>(&ckExpr.u)};
             CHECK(cp != nullptr);  // the parent was parsed as a constant string
+            CHECK(cp->size() == 1);
             StaticDataObject::Pointer staticData{StaticDataObject::Create()};
             staticData->set_alignment(Result::kind)
                 .set_itemBytes(Result::kind)
-                .Push(cp->value);
+                .Push(**cp);
             Substring substring{std::move(staticData), std::move(lower.value()),
                 std::move(upper.value())};
             return AsGenericExpr(Expr<SomeCharacter>{