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
getBase(const fir::ExtendedValue & exv)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
getLen(const fir::ExtendedValue & exv)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
substBase(const fir::ExtendedValue & exv,mlir::Value base)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>
getTypeParams(const fir::ExtendedValue & exv)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
isArray(const fir::ExtendedValue & exv)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
operator <<(llvm::raw_ostream & os,const fir::CharBoxValue & box)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
operator <<(llvm::raw_ostream & os,const fir::PolymorphicValue & p)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
operator <<(llvm::raw_ostream & os,const fir::ArrayBoxValue & box)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
operator <<(llvm::raw_ostream & os,const fir::CharArrayBoxValue & box)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
operator <<(llvm::raw_ostream & os,const fir::ProcBoxValue & box)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
operator <<(llvm::raw_ostream & os,const fir::BoxValue & box)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
operator <<(llvm::raw_ostream & os,const fir::MutableBoxValue & box)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
operator <<(llvm::raw_ostream & os,const fir::ExtendedValue & exv)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.
verify() const190 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.
verify() const212 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.
getExtentAtDimension(mlir::Location loc,fir::FirOpBuilder & builder,const fir::ExtendedValue & exv,unsigned dim)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 }
235