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::ArrayBoxValue &box) {
89   os << "boxarray { addr: " << box.getAddr();
90   if (box.getLBounds().size()) {
91     os << ", lbounds: [";
92     llvm::interleaveComma(box.getLBounds(), os);
93     os << "]";
94   } else {
95     os << ", lbounds: all-ones";
96   }
97   os << ", shape: [";
98   llvm::interleaveComma(box.getExtents(), os);
99   return os << "]}";
100 }
101 
102 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
103                                    const fir::CharArrayBoxValue &box) {
104   os << "boxchararray { addr: " << box.getAddr() << ", len : " << box.getLen();
105   if (box.getLBounds().size()) {
106     os << ", lbounds: [";
107     llvm::interleaveComma(box.getLBounds(), os);
108     os << "]";
109   } else {
110     os << " lbounds: all-ones";
111   }
112   os << ", shape: [";
113   llvm::interleaveComma(box.getExtents(), os);
114   return os << "]}";
115 }
116 
117 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
118                                    const fir::ProcBoxValue &box) {
119   return os << "boxproc: { procedure: " << box.getAddr()
120             << ", context: " << box.hostContext << "}";
121 }
122 
123 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
124                                    const fir::BoxValue &box) {
125   os << "box: { value: " << box.getAddr();
126   if (box.lbounds.size()) {
127     os << ", lbounds: [";
128     llvm::interleaveComma(box.lbounds, os);
129     os << "]";
130   }
131   if (!box.explicitParams.empty()) {
132     os << ", explicit type params: [";
133     llvm::interleaveComma(box.explicitParams, os);
134     os << "]";
135   }
136   if (!box.extents.empty()) {
137     os << ", explicit extents: [";
138     llvm::interleaveComma(box.extents, os);
139     os << "]";
140   }
141   return os << "}";
142 }
143 
144 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
145                                    const fir::MutableBoxValue &box) {
146   os << "mutablebox: { addr: " << box.getAddr();
147   if (!box.lenParams.empty()) {
148     os << ", non deferred type params: [";
149     llvm::interleaveComma(box.lenParams, os);
150     os << "]";
151   }
152   const auto &properties = box.mutableProperties;
153   if (!properties.isEmpty()) {
154     os << ", mutableProperties: { addr: " << properties.addr;
155     if (!properties.lbounds.empty()) {
156       os << ", lbounds: [";
157       llvm::interleaveComma(properties.lbounds, os);
158       os << "]";
159     }
160     if (!properties.extents.empty()) {
161       os << ", shape: [";
162       llvm::interleaveComma(properties.extents, os);
163       os << "]";
164     }
165     if (!properties.deferredParams.empty()) {
166       os << ", deferred type params: [";
167       llvm::interleaveComma(properties.deferredParams, os);
168       os << "]";
169     }
170     os << "}";
171   }
172   return os << "}";
173 }
174 
175 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
176                                    const fir::ExtendedValue &exv) {
177   exv.match([&](const auto &value) { os << value; });
178   return os;
179 }
180 
181 /// Debug verifier for MutableBox ctor. There is no guarantee that this will
182 /// always be called, so it should not have any functional side effects,
183 /// the const is here to enforce that.
184 bool fir::MutableBoxValue::verify() const {
185   mlir::Type type = fir::dyn_cast_ptrEleTy(getAddr().getType());
186   if (!type)
187     return false;
188   auto box = type.dyn_cast<fir::BoxType>();
189   if (!box)
190     return false;
191   // A boxed value always takes a memory reference,
192 
193   auto nParams = lenParams.size();
194   if (isCharacter()) {
195     if (nParams > 1)
196       return false;
197   } else if (!isDerived()) {
198     if (nParams != 0)
199       return false;
200   }
201   return true;
202 }
203 
204 /// Debug verifier for BoxValue ctor. There is no guarantee this will
205 /// always be called.
206 bool fir::BoxValue::verify() const {
207   if (!addr.getType().isa<fir::BoxType>())
208     return false;
209   if (!lbounds.empty() && lbounds.size() != rank())
210     return false;
211   // Explicit extents are here to cover cases where an explicit-shape dummy
212   // argument comes as a fir.box. This can only happen with derived types and
213   // unlimited polymorphic.
214   if (!extents.empty() && !(isDerived() || isUnlimitedPolymorphic()))
215     return false;
216   if (!extents.empty() && extents.size() != rank())
217     return false;
218   if (isCharacter() && explicitParams.size() > 1)
219     return false;
220   return true;
221 }
222 
223 /// Get exactly one extent for any array-like extended value, \p exv. If \p exv
224 /// is not an array or has rank less then \p dim, the result will be a nullptr.
225 mlir::Value fir::factory::getExtentAtDimension(mlir::Location loc,
226                                                fir::FirOpBuilder &builder,
227                                                const fir::ExtendedValue &exv,
228                                                unsigned dim) {
229   auto extents = fir::factory::getExtents(loc, builder, exv);
230   if (dim < extents.size())
231     return extents[dim];
232   return {};
233 }
234 
235 static inline bool isUndefOp(mlir::Value v) {
236   return mlir::isa_and_nonnull<fir::UndefOp>(v.getDefiningOp());
237 }
238 
239 bool fir::ExtendedValue::isAssumedSize() const {
240   return match(
241       [](const fir::ArrayBoxValue &box) -> bool {
242         return !box.getExtents().empty() && isUndefOp(box.getExtents().back());
243         ;
244       },
245       [](const fir::CharArrayBoxValue &box) -> bool {
246         return !box.getExtents().empty() && isUndefOp(box.getExtents().back());
247       },
248       [](const auto &box) -> bool { return false; });
249 }
250