flang/lib/Optimizer/Builder/BoxValue.cpp

   1 //===-- BoxValue.cpp ------------------------------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8 //
   9 // Pretty printers for box values, etc.
  10 //
  11 //===----------------------------------------------------------------------===//
  12
  13 #include "flang/Optimizer/Builder/BoxValue.h"
  14 #include "flang/Optimizer/Builder/FIRBuilder.h"
  15 #include "flang/Optimizer/Builder/Todo.h"
  16 #include "mlir/IR/BuiltinTypes.h"
  17 #include "llvm/Support/Debug.h"
  18
  19 #define DEBUG_TYPE "flang-box-value"
  20
  21 mlir::Value fir::getBase(const fir::ExtendedValue &exv) {
  22   return exv.match([](const fir::UnboxedValue &x) { return x; },
  23                    [](const auto &x) { return x.getAddr(); });
  24 }
  25
  26 mlir::Value fir::getLen(const fir::ExtendedValue &exv) {
  27   return exv.match(
  28       [](const fir::CharBoxValue &x) { return x.getLen(); },
  29       [](const fir::CharArrayBoxValue &x) { return x.getLen(); },
  30       [](const fir::BoxValue &) -> mlir::Value {
  31         llvm::report_fatal_error("Need to read len from BoxValue Exv");
  32       },
  33       [](const fir::MutableBoxValue &) -> mlir::Value {
  34         llvm::report_fatal_error("Need to read len from MutableBoxValue Exv");
  35       },
  36       [](const auto &) { return mlir::Value{}; });
  37 }
  38
  39 fir::ExtendedValue fir::substBase(const fir::ExtendedValue &exv,
  40                                   mlir::Value base) {
  41   return exv.match(
  42       [=](const fir::UnboxedValue &x) { return fir::ExtendedValue(base); },
  43       [=](const auto &x) { return fir::ExtendedValue(x.clone(base)); });
  44 }
  45
  46 llvm::SmallVector<mlir::Value>
  47 fir::getTypeParams(const fir::ExtendedValue &exv) {
  48   using RT = llvm::SmallVector<mlir::Value>;
  49   auto baseTy = fir::getBase(exv).getType();
  50   if (auto t = fir::dyn_cast_ptrEleTy(baseTy))
  51     baseTy = t;
  52   baseTy = fir::unwrapSequenceType(baseTy);
  53   if (!fir::hasDynamicSize(baseTy))
  54     return {}; // type has constant size, no type parameters needed
  55   [[maybe_unused]] auto loc = fir::getBase(exv).getLoc();
  56   return exv.match(
  57       [](const fir::CharBoxValue &x) -> RT { return {x.getLen()}; },
  58       [](const fir::CharArrayBoxValue &x) -> RT { return {x.getLen()}; },
  59       [&](const fir::BoxValue &) -> RT {
  60         TODO(loc, "box value is missing type parameters");
  61         return {};
  62       },
  63       [&](const fir::MutableBoxValue &) -> RT {
  64         // In this case, the type params may be bound to the variable in an
  65         // ALLOCATE statement as part of a type-spec.
  66         TODO(loc, "mutable box value is missing type parameters");
  67         return {};
  68       },
  69       [](const auto &) -> RT { return {}; });
  70 }
  71
  72 bool fir::isArray(const fir::ExtendedValue &exv) {
  73   return exv.match(
  74       [](const fir::ArrayBoxValue &) { return true; },
  75       [](const fir::CharArrayBoxValue &) { return true; },
  76       [](const fir::BoxValue &box) { return box.hasRank(); },
  77       [](const fir::MutableBoxValue &box) { return box.hasRank(); },
  78       [](auto) { return false; });
  79 }
  80
  81 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
  82                                    const fir::CharBoxValue &box) {
  83   return os << "boxchar { addr: " << box.getAddr() << ", len: " << box.getLen()
  84             << " }";
  85 }
  86
  87 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
  88                                    const fir::PolymorphicValue &p) {
  89   return os << "polymorphicvalue: { addr: " << p.getAddr()
  90             << ", sourceBox: " << p.getSourceBox() << " }";
  91 }
  92
  93 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
  94                                    const fir::ArrayBoxValue &box) {
  95   os << "boxarray { addr: " << box.getAddr();
  96   if (box.getLBounds().size()) {
  97     os << ", lbounds: [";
  98     llvm::interleaveComma(box.getLBounds(), os);
  99     os << "]";
 100   } else {
 101     os << ", lbounds: all-ones";
 102   }
 103   os << ", shape: [";
 104   llvm::interleaveComma(box.getExtents(), os);
 105   return os << "]}";
 106 }
 107
 108 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
 109                                    const fir::CharArrayBoxValue &box) {
 110   os << "boxchararray { addr: " << box.getAddr() << ", len : " << box.getLen();
 111   if (box.getLBounds().size()) {
 112     os << ", lbounds: [";
 113     llvm::interleaveComma(box.getLBounds(), os);
 114     os << "]";
 115   } else {
 116     os << " lbounds: all-ones";
 117   }
 118   os << ", shape: [";
 119   llvm::interleaveComma(box.getExtents(), os);
 120   return os << "]}";
 121 }
 122
 123 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
 124                                    const fir::ProcBoxValue &box) {
 125   return os << "boxproc: { procedure: " << box.getAddr()
 126             << ", context: " << box.hostContext << "}";
 127 }
 128
 129 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
 130                                    const fir::BoxValue &box) {
 131   os << "box: { value: " << box.getAddr();
 132   if (box.lbounds.size()) {
 133     os << ", lbounds: [";
 134     llvm::interleaveComma(box.lbounds, os);
 135     os << "]";
 136   }
 137   if (!box.explicitParams.empty()) {
 138     os << ", explicit type params: [";
 139     llvm::interleaveComma(box.explicitParams, os);
 140     os << "]";
 141   }
 142   if (!box.extents.empty()) {
 143     os << ", explicit extents: [";
 144     llvm::interleaveComma(box.extents, os);
 145     os << "]";
 146   }
 147   return os << "}";
 148 }
 149
 150 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
 151                                    const fir::MutableBoxValue &box) {
 152   os << "mutablebox: { addr: " << box.getAddr();
 153   if (!box.lenParams.empty()) {
 154     os << ", non deferred type params: [";
 155     llvm::interleaveComma(box.lenParams, os);
 156     os << "]";
 157   }
 158   const auto &properties = box.mutableProperties;
 159   if (!properties.isEmpty()) {
 160     os << ", mutableProperties: { addr: " << properties.addr;
 161     if (!properties.lbounds.empty()) {
 162       os << ", lbounds: [";
 163       llvm::interleaveComma(properties.lbounds, os);
 164       os << "]";
 165     }
 166     if (!properties.extents.empty()) {
 167       os << ", shape: [";
 168       llvm::interleaveComma(properties.extents, os);
 169       os << "]";
 170     }
 171     if (!properties.deferredParams.empty()) {
 172       os << ", deferred type params: [";
 173       llvm::interleaveComma(properties.deferredParams, os);
 174       os << "]";
 175     }
 176     os << "}";
 177   }
 178   return os << "}";
 179 }
 180
 181 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
 182                                    const fir::ExtendedValue &exv) {
 183   exv.match([&](const auto &value) { os << value; });
 184   return os;
 185 }
 186
 187 /// Debug verifier for MutableBox ctor. There is no guarantee that this will
 188 /// always be called, so it should not have any functional side effects,
 189 /// the const is here to enforce that.
 190 bool fir::MutableBoxValue::verify() const {
 191   mlir::Type type = fir::dyn_cast_ptrEleTy(getAddr().getType());
 192   if (!type)
 193     return false;
 194   auto box = mlir::dyn_cast<fir::BaseBoxType>(type);
 195   if (!box)
 196     return false;
 197   // A boxed value always takes a memory reference,
 198
 199   auto nParams = lenParams.size();
 200   if (isCharacter()) {
 201     if (nParams > 1)
 202       return false;
 203   } else if (!isDerived()) {
 204     if (nParams != 0)
 205       return false;
 206   }
 207   return true;
 208 }
 209
 210 /// Debug verifier for BoxValue ctor. There is no guarantee this will
 211 /// always be called.
 212 bool fir::BoxValue::verify() const {
 213   if (!mlir::isa<fir::BaseBoxType>(addr.getType()))
 214     return false;
 215   if (!lbounds.empty() && lbounds.size() != rank())
 216     return false;
 217   if (!extents.empty() && extents.size() != rank())
 218     return false;
 219   if (isCharacter() && explicitParams.size() > 1)
 220     return false;
 221   return true;
 222 }
 223
 224 /// Get exactly one extent for any array-like extended value, \p exv. If \p exv
 225 /// is not an array or has rank less then \p dim, the result will be a nullptr.
 226 mlir::Value fir::factory::getExtentAtDimension(mlir::Location loc,
 227                                                fir::FirOpBuilder &builder,
 228                                                const fir::ExtendedValue &exv,
 229                                                unsigned dim) {
 230   auto extents = fir::factory::getExtents(loc, builder, exv);
 231   if (dim < extents.size())
 232     return extents[dim];
 233   return {};
 234 }