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 "mlir/IR/BuiltinTypes.h"
15 #include "llvm/Support/Debug.h"
16 
17 #define DEBUG_TYPE "flang-box-value"
18 
19 mlir::Value fir::getBase(const fir::ExtendedValue &exv) {
20   return exv.match([](const fir::UnboxedValue &x) { return x; },
21                    [](const auto &x) { return x.getAddr(); });
22 }
23 
24 mlir::Value fir::getLen(const fir::ExtendedValue &exv) {
25   return exv.match(
26       [](const fir::CharBoxValue &x) { return x.getLen(); },
27       [](const fir::CharArrayBoxValue &x) { return x.getLen(); },
28       [](const fir::BoxValue &) -> mlir::Value {
29         llvm::report_fatal_error("Need to read len from BoxValue Exv");
30       },
31       [](const fir::MutableBoxValue &) -> mlir::Value {
32         llvm::report_fatal_error("Need to read len from MutableBoxValue Exv");
33       },
34       [](const auto &) { return mlir::Value{}; });
35 }
36 
37 fir::ExtendedValue fir::substBase(const fir::ExtendedValue &exv,
38                                   mlir::Value base) {
39   return exv.match(
40       [=](const fir::UnboxedValue &x) { return fir::ExtendedValue(base); },
41       [=](const fir::BoxValue &) -> fir::ExtendedValue {
42         llvm::report_fatal_error("TODO: substbase of BoxValue");
43       },
44       [=](const fir::MutableBoxValue &) -> fir::ExtendedValue {
45         llvm::report_fatal_error("TODO: substbase of MutableBoxValue");
46       },
47       [=](const auto &x) { return fir::ExtendedValue(x.clone(base)); });
48 }
49 
50 llvm::SmallVector<mlir::Value> fir::getTypeParams(const ExtendedValue &exv) {
51   using RT = llvm::SmallVector<mlir::Value>;
52   auto baseTy = fir::getBase(exv).getType();
53   if (auto t = fir::dyn_cast_ptrEleTy(baseTy))
54     baseTy = t;
55   baseTy = fir::unwrapSequenceType(baseTy);
56   if (!fir::hasDynamicSize(baseTy))
57     return {}; // type has constant size, no type parameters needed
58   [[maybe_unused]] auto loc = fir::getBase(exv).getLoc();
59   return exv.match(
60       [](const fir::CharBoxValue &x) -> RT { return {x.getLen()}; },
61       [](const fir::CharArrayBoxValue &x) -> RT { return {x.getLen()}; },
62       [&](const fir::BoxValue &) -> RT {
63         LLVM_DEBUG(mlir::emitWarning(
64             loc, "TODO: box value is missing type parameters"));
65         return {};
66       },
67       [&](const fir::MutableBoxValue &) -> RT {
68         // In this case, the type params may be bound to the variable in an
69         // ALLOCATE statement as part of a type-spec.
70         LLVM_DEBUG(mlir::emitWarning(
71             loc, "TODO: mutable box value is missing type parameters"));
72         return {};
73       },
74       [](const auto &) -> RT { return {}; });
75 }
76 
77 bool fir::isArray(const fir::ExtendedValue &exv) {
78   return exv.match(
79       [](const fir::ArrayBoxValue &) { return true; },
80       [](const fir::CharArrayBoxValue &) { return true; },
81       [](const fir::BoxValue &box) { return box.hasRank(); },
82       [](const fir::MutableBoxValue &box) { return box.hasRank(); },
83       [](auto) { return false; });
84 }
85 
86 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
87                                    const fir::CharBoxValue &box) {
88   return os << "boxchar { addr: " << box.getAddr() << ", len: " << box.getLen()
89             << " }";
90 }
91 
92 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
93                                    const fir::ArrayBoxValue &box) {
94   os << "boxarray { addr: " << box.getAddr();
95   if (box.getLBounds().size()) {
96     os << ", lbounds: [";
97     llvm::interleaveComma(box.getLBounds(), os);
98     os << "]";
99   } else {
100     os << ", lbounds: all-ones";
101   }
102   os << ", shape: [";
103   llvm::interleaveComma(box.getExtents(), os);
104   return os << "]}";
105 }
106 
107 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
108                                    const fir::CharArrayBoxValue &box) {
109   os << "boxchararray { addr: " << box.getAddr() << ", len : " << box.getLen();
110   if (box.getLBounds().size()) {
111     os << ", lbounds: [";
112     llvm::interleaveComma(box.getLBounds(), os);
113     os << "]";
114   } else {
115     os << " lbounds: all-ones";
116   }
117   os << ", shape: [";
118   llvm::interleaveComma(box.getExtents(), os);
119   return os << "]}";
120 }
121 
122 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
123                                    const fir::ProcBoxValue &box) {
124   return os << "boxproc: { procedure: " << box.getAddr()
125             << ", context: " << box.hostContext << "}";
126 }
127 
128 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
129                                    const fir::BoxValue &box) {
130   os << "box: { value: " << box.getAddr();
131   if (box.lbounds.size()) {
132     os << ", lbounds: [";
133     llvm::interleaveComma(box.lbounds, os);
134     os << "]";
135   }
136   if (!box.explicitParams.empty()) {
137     os << ", explicit type params: [";
138     llvm::interleaveComma(box.explicitParams, os);
139     os << "]";
140   }
141   if (!box.extents.empty()) {
142     os << ", explicit extents: [";
143     llvm::interleaveComma(box.extents, os);
144     os << "]";
145   }
146   return os << "}";
147 }
148 
149 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
150                                    const fir::MutableBoxValue &box) {
151   os << "mutablebox: { addr: " << box.getAddr();
152   if (!box.lenParams.empty()) {
153     os << ", non deferred type params: [";
154     llvm::interleaveComma(box.lenParams, os);
155     os << "]";
156   }
157   const auto &properties = box.mutableProperties;
158   if (!properties.isEmpty()) {
159     os << ", mutableProperties: { addr: " << properties.addr;
160     if (!properties.lbounds.empty()) {
161       os << ", lbounds: [";
162       llvm::interleaveComma(properties.lbounds, os);
163       os << "]";
164     }
165     if (!properties.extents.empty()) {
166       os << ", shape: [";
167       llvm::interleaveComma(properties.extents, os);
168       os << "]";
169     }
170     if (!properties.deferredParams.empty()) {
171       os << ", deferred type params: [";
172       llvm::interleaveComma(properties.deferredParams, os);
173       os << "]";
174     }
175     os << "}";
176   }
177   return os << "}";
178 }
179 
180 llvm::raw_ostream &fir::operator<<(llvm::raw_ostream &os,
181                                    const fir::ExtendedValue &exv) {
182   exv.match([&](const auto &value) { os << value; });
183   return os;
184 }
185 
186 /// Debug verifier for MutableBox ctor. There is no guarantee that this will
187 /// always be called, so it should not have any functional side effects,
188 /// the const is here to enforce that.
189 bool fir::MutableBoxValue::verify() const {
190   auto type = fir::dyn_cast_ptrEleTy(getAddr().getType());
191   if (!type)
192     return false;
193   auto box = type.dyn_cast<fir::BoxType>();
194   if (!box)
195     return false;
196   auto eleTy = box.getEleTy();
197   if (!eleTy.isa<fir::PointerType>() && !eleTy.isa<fir::HeapType>())
198     return false;
199 
200   auto nParams = lenParams.size();
201   if (isCharacter()) {
202     if (nParams > 1)
203       return false;
204   } else if (!isDerived()) {
205     if (nParams != 0)
206       return false;
207   }
208   return true;
209 }
210 
211 /// Debug verifier for BoxValue ctor. There is no guarantee this will
212 /// always be called.
213 bool fir::BoxValue::verify() const {
214   if (!addr.getType().isa<fir::BoxType>())
215     return false;
216   if (!lbounds.empty() && lbounds.size() != rank())
217     return false;
218   // Explicit extents are here to cover cases where an explicit-shape dummy
219   // argument comes as a fir.box. This can only happen with derived types and
220   // unlimited polymorphic.
221   if (!extents.empty() && !(isDerived() || isUnlimitedPolymorphic()))
222     return false;
223   if (!extents.empty() && extents.size() != rank())
224     return false;
225   if (isCharacter() && explicitParams.size() > 1)
226     return false;
227   return true;
228 }
229