1 | //===-- lib/Evaluate/variable.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 | #include "flang/Evaluate/variable.h" |
10 | #include "flang/Common/idioms.h" |
11 | #include "flang/Evaluate/check-expression.h" |
12 | #include "flang/Evaluate/fold.h" |
13 | #include "flang/Evaluate/tools.h" |
14 | #include "flang/Parser/char-block.h" |
15 | #include "flang/Parser/characters.h" |
16 | #include "flang/Parser/message.h" |
17 | #include "flang/Semantics/scope.h" |
18 | #include "flang/Semantics/symbol.h" |
19 | #include <type_traits> |
20 | |
21 | using namespace Fortran::parser::literals; |
22 | |
23 | namespace Fortran::evaluate { |
24 | |
25 | // Constructors, accessors, mutators |
26 | |
27 | Triplet::Triplet() : stride_{Expr<SubscriptInteger>{1}} {} |
28 | |
29 | Triplet::Triplet(std::optional<Expr<SubscriptInteger>> &&l, |
30 | std::optional<Expr<SubscriptInteger>> &&u, |
31 | std::optional<Expr<SubscriptInteger>> &&s) |
32 | : stride_{s ? std::move(*s) : Expr<SubscriptInteger>{1}} { |
33 | if (l) { |
34 | lower_.emplace(std::move(*l)); |
35 | } |
36 | if (u) { |
37 | upper_.emplace(std::move(*u)); |
38 | } |
39 | } |
40 | |
41 | std::optional<Expr<SubscriptInteger>> Triplet::lower() const { |
42 | if (lower_) { |
43 | return {lower_.value().value()}; |
44 | } |
45 | return std::nullopt; |
46 | } |
47 | |
48 | Triplet &Triplet::set_lower(Expr<SubscriptInteger> &&expr) { |
49 | lower_.emplace(std::move(expr)); |
50 | return *this; |
51 | } |
52 | |
53 | std::optional<Expr<SubscriptInteger>> Triplet::upper() const { |
54 | if (upper_) { |
55 | return {upper_.value().value()}; |
56 | } |
57 | return std::nullopt; |
58 | } |
59 | |
60 | Triplet &Triplet::set_upper(Expr<SubscriptInteger> &&expr) { |
61 | upper_.emplace(std::move(expr)); |
62 | return *this; |
63 | } |
64 | |
65 | Expr<SubscriptInteger> Triplet::stride() const { return stride_.value(); } |
66 | |
67 | Triplet &Triplet::set_stride(Expr<SubscriptInteger> &&expr) { |
68 | stride_.value() = std::move(expr); |
69 | return *this; |
70 | } |
71 | |
72 | CoarrayRef::CoarrayRef(SymbolVector &&base, std::vector<Subscript> &&ss, |
73 | std::vector<Expr<SubscriptInteger>> &&css) |
74 | : base_{std::move(base)}, subscript_(std::move(ss)), |
75 | cosubscript_(std::move(css)) { |
76 | CHECK(!base_.empty()); |
77 | CHECK(!cosubscript_.empty()); |
78 | } |
79 | |
80 | std::optional<Expr<SomeInteger>> CoarrayRef::stat() const { |
81 | if (stat_) { |
82 | return stat_.value().value(); |
83 | } else { |
84 | return std::nullopt; |
85 | } |
86 | } |
87 | |
88 | std::optional<Expr<SomeInteger>> CoarrayRef::team() const { |
89 | if (team_) { |
90 | return team_.value().value(); |
91 | } else { |
92 | return std::nullopt; |
93 | } |
94 | } |
95 | |
96 | CoarrayRef &CoarrayRef::set_stat(Expr<SomeInteger> &&v) { |
97 | CHECK(IsVariable(v)); |
98 | stat_.emplace(std::move(v)); |
99 | return *this; |
100 | } |
101 | |
102 | CoarrayRef &CoarrayRef::set_team(Expr<SomeInteger> &&v, bool isTeamNumber) { |
103 | CHECK(IsVariable(v)); |
104 | team_.emplace(std::move(v)); |
105 | teamIsTeamNumber_ = isTeamNumber; |
106 | return *this; |
107 | } |
108 | |
109 | const Symbol &CoarrayRef::GetFirstSymbol() const { return base_.front(); } |
110 | |
111 | const Symbol &CoarrayRef::GetLastSymbol() const { return base_.back(); } |
112 | |
113 | void Substring::SetBounds(std::optional<Expr<SubscriptInteger>> &lower, |
114 | std::optional<Expr<SubscriptInteger>> &upper) { |
115 | if (lower) { |
116 | set_lower(std::move(lower.value())); |
117 | } |
118 | if (upper) { |
119 | set_upper(std::move(upper.value())); |
120 | } |
121 | } |
122 | |
123 | Expr<SubscriptInteger> Substring::lower() const { |
124 | if (lower_) { |
125 | return lower_.value().value(); |
126 | } else { |
127 | return AsExpr(Constant<SubscriptInteger>{1}); |
128 | } |
129 | } |
130 | |
131 | Substring &Substring::set_lower(Expr<SubscriptInteger> &&expr) { |
132 | lower_.emplace(std::move(expr)); |
133 | return *this; |
134 | } |
135 | |
136 | std::optional<Expr<SubscriptInteger>> Substring::upper() const { |
137 | if (upper_) { |
138 | return upper_.value().value(); |
139 | } else { |
140 | return common::visit( |
141 | common::visitors{ |
142 | [](const DataRef &dataRef) { return dataRef.LEN(); }, |
143 | [](const StaticDataObject::Pointer &object) |
144 | -> std::optional<Expr<SubscriptInteger>> { |
145 | return AsExpr(Constant<SubscriptInteger>{object->data().size()}); |
146 | }, |
147 | }, |
148 | parent_); |
149 | } |
150 | } |
151 | |
152 | Substring &Substring::set_upper(Expr<SubscriptInteger> &&expr) { |
153 | upper_.emplace(std::move(expr)); |
154 | return *this; |
155 | } |
156 | |
157 | std::optional<Expr<SomeCharacter>> Substring::Fold(FoldingContext &context) { |
158 | if (!upper_) { |
159 | upper_ = upper(); |
160 | if (!upper_) { |
161 | return std::nullopt; |
162 | } |
163 | } |
164 | upper_.value() = evaluate::Fold(context, std::move(upper_.value().value())); |
165 | std::optional<ConstantSubscript> ubi{ToInt64(upper_.value().value())}; |
166 | if (!ubi) { |
167 | return std::nullopt; |
168 | } |
169 | if (!lower_) { |
170 | lower_ = AsExpr(Constant<SubscriptInteger>{1}); |
171 | } |
172 | lower_.value() = evaluate::Fold(context, std::move(lower_.value().value())); |
173 | std::optional<ConstantSubscript> lbi{ToInt64(lower_.value().value())}; |
174 | if (!lbi) { |
175 | return std::nullopt; |
176 | } |
177 | if (*lbi > *ubi) { // empty result; canonicalize |
178 | *lbi = 1; |
179 | *ubi = 0; |
180 | lower_ = AsExpr(Constant<SubscriptInteger>{*lbi}); |
181 | upper_ = AsExpr(Constant<SubscriptInteger>{*ubi}); |
182 | } |
183 | std::optional<ConstantSubscript> length; |
184 | std::optional<Expr<SomeCharacter>> strings; // a Constant<Character> |
185 | if (const auto *literal{std::get_if<StaticDataObject::Pointer>(&parent_)}) { |
186 | length = (*literal)->data().size(); |
187 | if (auto str{(*literal)->AsString()}) { |
188 | strings = |
189 | Expr<SomeCharacter>(Expr<Ascii>(Constant<Ascii>{std::move(*str)})); |
190 | } |
191 | } else if (const auto *dataRef{std::get_if<DataRef>(&parent_)}) { |
192 | if (auto expr{AsGenericExpr(DataRef{*dataRef})}) { |
193 | auto folded{evaluate::Fold(context, std::move(*expr))}; |
194 | if (IsActuallyConstant(folded)) { |
195 | if (const auto *value{UnwrapExpr<Expr<SomeCharacter>>(folded)}) { |
196 | strings = *value; |
197 | } |
198 | } |
199 | } |
200 | } |
201 | std::optional<Expr<SomeCharacter>> result; |
202 | if (strings) { |
203 | result = common::visit( |
204 | [&](const auto &expr) -> std::optional<Expr<SomeCharacter>> { |
205 | using Type = typename std::decay_t<decltype(expr)>::Result; |
206 | if (const auto *cc{std::get_if<Constant<Type>>(&expr.u)}) { |
207 | if (auto substr{cc->Substring(*lbi, *ubi)}) { |
208 | return Expr<SomeCharacter>{Expr<Type>{*substr}}; |
209 | } |
210 | } |
211 | return std::nullopt; |
212 | }, |
213 | strings->u); |
214 | } |
215 | if (!result) { // error cases |
216 | if (*lbi < 1) { |
217 | context.messages().Say( |
218 | "Lower bound (%jd) on substring is less than one"_warn_en_US , |
219 | static_cast<std::intmax_t>(*lbi)); |
220 | *lbi = 1; |
221 | lower_ = AsExpr(Constant<SubscriptInteger>{1}); |
222 | } |
223 | if (length && *ubi > *length) { |
224 | context.messages().Say( |
225 | "Upper bound (%jd) on substring is greater than character length (%jd)"_warn_en_US , |
226 | static_cast<std::intmax_t>(*ubi), |
227 | static_cast<std::intmax_t>(*length)); |
228 | *ubi = *length; |
229 | upper_ = AsExpr(Constant<SubscriptInteger>{*ubi}); |
230 | } |
231 | } |
232 | return result; |
233 | } |
234 | |
235 | DescriptorInquiry::DescriptorInquiry( |
236 | const NamedEntity &base, Field field, int dim) |
237 | : base_{base}, field_{field}, dimension_{dim} { |
238 | const Symbol &last{base_.GetLastSymbol()}; |
239 | CHECK(IsDescriptor(last)); |
240 | CHECK(((field == Field::Len || field == Field::Rank) && dim == 0) || |
241 | (field != Field::Len && dim >= 0 && dim < last.Rank())); |
242 | } |
243 | |
244 | DescriptorInquiry::DescriptorInquiry(NamedEntity &&base, Field field, int dim) |
245 | : base_{std::move(base)}, field_{field}, dimension_{dim} { |
246 | const Symbol &last{base_.GetLastSymbol()}; |
247 | CHECK(IsDescriptor(last)); |
248 | CHECK((field == Field::Len && dim == 0) || |
249 | (field != Field::Len && dim >= 0 && dim < last.Rank())); |
250 | } |
251 | |
252 | // LEN() |
253 | static std::optional<Expr<SubscriptInteger>> SymbolLEN(const Symbol &symbol) { |
254 | const Symbol &ultimate{symbol.GetUltimate()}; |
255 | if (const auto *assoc{ultimate.detailsIf<semantics::AssocEntityDetails>()}) { |
256 | if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(assoc->expr())}) { |
257 | return chExpr->LEN(); |
258 | } |
259 | } |
260 | if (auto dyType{DynamicType::From(ultimate)}) { |
261 | auto len{dyType->GetCharLength()}; |
262 | if (!len && ultimate.attrs().test(semantics::Attr::PARAMETER)) { |
263 | // Its initializer determines the length of an implied-length named |
264 | // constant. |
265 | if (const auto *object{ |
266 | ultimate.detailsIf<semantics::ObjectEntityDetails>()}) { |
267 | if (object->init()) { |
268 | if (auto dyType2{DynamicType::From(*object->init())}) { |
269 | len = dyType2->GetCharLength(); |
270 | } |
271 | } |
272 | } |
273 | } |
274 | if (len) { |
275 | if (auto constLen{ToInt64(*len)}) { |
276 | return Expr<SubscriptInteger>{std::max<std::int64_t>(*constLen, 0)}; |
277 | } else if (ultimate.owner().IsDerivedType() || |
278 | IsScopeInvariantExpr(*len)) { |
279 | return AsExpr(Extremum<SubscriptInteger>{ |
280 | Ordering::Greater, Expr<SubscriptInteger>{0}, std::move(*len)}); |
281 | } |
282 | } |
283 | } |
284 | if (IsDescriptor(ultimate) && !ultimate.owner().IsDerivedType()) { |
285 | return Expr<SubscriptInteger>{ |
286 | DescriptorInquiry{NamedEntity{symbol}, DescriptorInquiry::Field::Len}}; |
287 | } |
288 | return std::nullopt; |
289 | } |
290 | |
291 | std::optional<Expr<SubscriptInteger>> BaseObject::LEN() const { |
292 | return common::visit( |
293 | common::visitors{ |
294 | [](const Symbol &symbol) { return SymbolLEN(symbol); }, |
295 | [](const StaticDataObject::Pointer &object) |
296 | -> std::optional<Expr<SubscriptInteger>> { |
297 | return AsExpr(Constant<SubscriptInteger>{object->data().size()}); |
298 | }, |
299 | }, |
300 | u); |
301 | } |
302 | |
303 | std::optional<Expr<SubscriptInteger>> Component::LEN() const { |
304 | return SymbolLEN(GetLastSymbol()); |
305 | } |
306 | |
307 | std::optional<Expr<SubscriptInteger>> NamedEntity::LEN() const { |
308 | return SymbolLEN(GetLastSymbol()); |
309 | } |
310 | |
311 | std::optional<Expr<SubscriptInteger>> ArrayRef::LEN() const { |
312 | return base_.LEN(); |
313 | } |
314 | |
315 | std::optional<Expr<SubscriptInteger>> CoarrayRef::LEN() const { |
316 | return SymbolLEN(GetLastSymbol()); |
317 | } |
318 | |
319 | std::optional<Expr<SubscriptInteger>> DataRef::LEN() const { |
320 | return common::visit(common::visitors{ |
321 | [](SymbolRef symbol) { return SymbolLEN(symbol); }, |
322 | [](const auto &x) { return x.LEN(); }, |
323 | }, |
324 | u); |
325 | } |
326 | |
327 | std::optional<Expr<SubscriptInteger>> Substring::LEN() const { |
328 | if (auto top{upper()}) { |
329 | return AsExpr(Extremum<SubscriptInteger>{Ordering::Greater, |
330 | AsExpr(Constant<SubscriptInteger>{0}), |
331 | *std::move(top) - lower() + AsExpr(Constant<SubscriptInteger>{1})}); |
332 | } else { |
333 | return std::nullopt; |
334 | } |
335 | } |
336 | |
337 | template <typename T> |
338 | std::optional<Expr<SubscriptInteger>> Designator<T>::LEN() const { |
339 | if constexpr (T::category == TypeCategory::Character) { |
340 | return common::visit(common::visitors{ |
341 | [](SymbolRef symbol) { return SymbolLEN(symbol); }, |
342 | [](const auto &x) { return x.LEN(); }, |
343 | }, |
344 | u); |
345 | } else { |
346 | common::die("Designator<non-char>::LEN() called" ); |
347 | return std::nullopt; |
348 | } |
349 | } |
350 | |
351 | std::optional<Expr<SubscriptInteger>> ProcedureDesignator::LEN() const { |
352 | using T = std::optional<Expr<SubscriptInteger>>; |
353 | return common::visit( |
354 | common::visitors{ |
355 | [](SymbolRef symbol) -> T { return SymbolLEN(symbol); }, |
356 | [](const common::CopyableIndirection<Component> &c) -> T { |
357 | return c.value().LEN(); |
358 | }, |
359 | [](const SpecificIntrinsic &i) -> T { |
360 | // Some cases whose results' lengths can be determined |
361 | // from the lengths of their arguments are handled in |
362 | // ProcedureRef::LEN() before coming here. |
363 | if (const auto &result{i.characteristics.value().functionResult}) { |
364 | if (const auto *type{result->GetTypeAndShape()}) { |
365 | if (auto length{type->type().GetCharLength()}) { |
366 | return std::move(*length); |
367 | } |
368 | } |
369 | } |
370 | return std::nullopt; |
371 | }, |
372 | }, |
373 | u); |
374 | } |
375 | |
376 | // Rank() |
377 | int BaseObject::Rank() const { |
378 | return common::visit(common::visitors{ |
379 | [](SymbolRef symbol) { return symbol->Rank(); }, |
380 | [](const StaticDataObject::Pointer &) { return 0; }, |
381 | }, |
382 | u); |
383 | } |
384 | |
385 | int Component::Rank() const { |
386 | if (int rank{symbol_->Rank()}; rank > 0) { |
387 | return rank; |
388 | } |
389 | return base().Rank(); |
390 | } |
391 | |
392 | int NamedEntity::Rank() const { |
393 | return common::visit(common::visitors{ |
394 | [](const SymbolRef s) { return s->Rank(); }, |
395 | [](const Component &c) { return c.Rank(); }, |
396 | }, |
397 | u_); |
398 | } |
399 | |
400 | int Subscript::Rank() const { |
401 | return common::visit(common::visitors{ |
402 | [](const IndirectSubscriptIntegerExpr &x) { |
403 | return x.value().Rank(); |
404 | }, |
405 | [](const Triplet &) { return 1; }, |
406 | }, |
407 | u); |
408 | } |
409 | |
410 | int ArrayRef::Rank() const { |
411 | int rank{0}; |
412 | for (const auto &expr : subscript_) { |
413 | rank += expr.Rank(); |
414 | } |
415 | if (rank > 0) { |
416 | return rank; |
417 | } else if (const Component * component{base_.UnwrapComponent()}) { |
418 | return component->base().Rank(); |
419 | } else { |
420 | return 0; |
421 | } |
422 | } |
423 | |
424 | int CoarrayRef::Rank() const { |
425 | if (!subscript_.empty()) { |
426 | int rank{0}; |
427 | for (const auto &expr : subscript_) { |
428 | rank += expr.Rank(); |
429 | } |
430 | return rank; |
431 | } else { |
432 | return base_.back()->Rank(); |
433 | } |
434 | } |
435 | |
436 | int DataRef::Rank() const { |
437 | return common::visit(common::visitors{ |
438 | [](SymbolRef symbol) { return symbol->Rank(); }, |
439 | [](const auto &x) { return x.Rank(); }, |
440 | }, |
441 | u); |
442 | } |
443 | |
444 | int Substring::Rank() const { |
445 | return common::visit( |
446 | common::visitors{ |
447 | [](const DataRef &dataRef) { return dataRef.Rank(); }, |
448 | [](const StaticDataObject::Pointer &) { return 0; }, |
449 | }, |
450 | parent_); |
451 | } |
452 | |
453 | int ComplexPart::Rank() const { return complex_.Rank(); } |
454 | |
455 | template <typename T> int Designator<T>::Rank() const { |
456 | return common::visit(common::visitors{ |
457 | [](SymbolRef symbol) { return symbol->Rank(); }, |
458 | [](const auto &x) { return x.Rank(); }, |
459 | }, |
460 | u); |
461 | } |
462 | |
463 | // GetBaseObject(), GetFirstSymbol(), GetLastSymbol(), &c. |
464 | const Symbol &Component::GetFirstSymbol() const { |
465 | return base_.value().GetFirstSymbol(); |
466 | } |
467 | |
468 | const Symbol &NamedEntity::GetFirstSymbol() const { |
469 | return common::visit(common::visitors{ |
470 | [](SymbolRef s) -> const Symbol & { return s; }, |
471 | [](const Component &c) -> const Symbol & { |
472 | return c.GetFirstSymbol(); |
473 | }, |
474 | }, |
475 | u_); |
476 | } |
477 | |
478 | const Symbol &NamedEntity::GetLastSymbol() const { |
479 | return common::visit(common::visitors{ |
480 | [](SymbolRef s) -> const Symbol & { return s; }, |
481 | [](const Component &c) -> const Symbol & { |
482 | return c.GetLastSymbol(); |
483 | }, |
484 | }, |
485 | u_); |
486 | } |
487 | |
488 | const SymbolRef *NamedEntity::UnwrapSymbolRef() const { |
489 | return common::visit( |
490 | common::visitors{ |
491 | [](const SymbolRef &s) { return &s; }, |
492 | [](const Component &) -> const SymbolRef * { return nullptr; }, |
493 | }, |
494 | u_); |
495 | } |
496 | |
497 | SymbolRef *NamedEntity::UnwrapSymbolRef() { |
498 | return common::visit(common::visitors{ |
499 | [](SymbolRef &s) { return &s; }, |
500 | [](Component &) -> SymbolRef * { return nullptr; }, |
501 | }, |
502 | u_); |
503 | } |
504 | |
505 | const Component *NamedEntity::UnwrapComponent() const { |
506 | return common::visit( |
507 | common::visitors{ |
508 | [](SymbolRef) -> const Component * { return nullptr; }, |
509 | [](const Component &c) { return &c; }, |
510 | }, |
511 | u_); |
512 | } |
513 | |
514 | Component *NamedEntity::UnwrapComponent() { |
515 | return common::visit(common::visitors{ |
516 | [](SymbolRef &) -> Component * { return nullptr; }, |
517 | [](Component &c) { return &c; }, |
518 | }, |
519 | u_); |
520 | } |
521 | |
522 | const Symbol &ArrayRef::GetFirstSymbol() const { |
523 | return base_.GetFirstSymbol(); |
524 | } |
525 | |
526 | const Symbol &ArrayRef::GetLastSymbol() const { return base_.GetLastSymbol(); } |
527 | |
528 | const Symbol &DataRef::GetFirstSymbol() const { |
529 | return *common::visit(common::visitors{ |
530 | [](SymbolRef symbol) { return &*symbol; }, |
531 | [](const auto &x) { return &x.GetFirstSymbol(); }, |
532 | }, |
533 | u); |
534 | } |
535 | |
536 | const Symbol &DataRef::GetLastSymbol() const { |
537 | return *common::visit(common::visitors{ |
538 | [](SymbolRef symbol) { return &*symbol; }, |
539 | [](const auto &x) { return &x.GetLastSymbol(); }, |
540 | }, |
541 | u); |
542 | } |
543 | |
544 | BaseObject Substring::GetBaseObject() const { |
545 | return common::visit(common::visitors{ |
546 | [](const DataRef &dataRef) { |
547 | return BaseObject{dataRef.GetFirstSymbol()}; |
548 | }, |
549 | [](StaticDataObject::Pointer pointer) { |
550 | return BaseObject{std::move(pointer)}; |
551 | }, |
552 | }, |
553 | parent_); |
554 | } |
555 | |
556 | const Symbol *Substring::GetLastSymbol() const { |
557 | return common::visit( |
558 | common::visitors{ |
559 | [](const DataRef &dataRef) { return &dataRef.GetLastSymbol(); }, |
560 | [](const auto &) -> const Symbol * { return nullptr; }, |
561 | }, |
562 | parent_); |
563 | } |
564 | |
565 | template <typename T> BaseObject Designator<T>::GetBaseObject() const { |
566 | return common::visit( |
567 | common::visitors{ |
568 | [](SymbolRef symbol) { return BaseObject{symbol}; }, |
569 | [](const Substring &sstring) { return sstring.GetBaseObject(); }, |
570 | [](const auto &x) { return BaseObject{x.GetFirstSymbol()}; }, |
571 | }, |
572 | u); |
573 | } |
574 | |
575 | template <typename T> const Symbol *Designator<T>::GetLastSymbol() const { |
576 | return common::visit( |
577 | common::visitors{ |
578 | [](SymbolRef symbol) { return &*symbol; }, |
579 | [](const Substring &sstring) { return sstring.GetLastSymbol(); }, |
580 | [](const auto &x) { return &x.GetLastSymbol(); }, |
581 | }, |
582 | u); |
583 | } |
584 | |
585 | template <typename T> |
586 | std::optional<DynamicType> Designator<T>::GetType() const { |
587 | if constexpr (IsLengthlessIntrinsicType<Result>) { |
588 | return Result::GetType(); |
589 | } |
590 | if constexpr (Result::category == TypeCategory::Character) { |
591 | if (std::holds_alternative<Substring>(u)) { |
592 | if (auto len{LEN()}) { |
593 | if (auto n{ToInt64(*len)}) { |
594 | return DynamicType{T::kind, *n}; |
595 | } |
596 | } |
597 | return DynamicType{TypeCategory::Character, T::kind}; |
598 | } |
599 | } |
600 | if (const Symbol * symbol{GetLastSymbol()}) { |
601 | return DynamicType::From(*symbol); |
602 | } |
603 | return std::nullopt; |
604 | } |
605 | |
606 | static NamedEntity AsNamedEntity(const SymbolVector &x) { |
607 | CHECK(!x.empty()); |
608 | NamedEntity result{x.front()}; |
609 | int j{0}; |
610 | for (const Symbol &symbol : x) { |
611 | if (j++ != 0) { |
612 | DataRef base{result.IsSymbol() ? DataRef{result.GetLastSymbol()} |
613 | : DataRef{result.GetComponent()}}; |
614 | result = NamedEntity{Component{std::move(base), symbol}}; |
615 | } |
616 | } |
617 | return result; |
618 | } |
619 | |
620 | NamedEntity CoarrayRef::GetBase() const { return AsNamedEntity(base_); } |
621 | |
622 | // Equality testing |
623 | |
624 | // For the purposes of comparing type parameter expressions while |
625 | // testing the compatibility of procedure characteristics, two |
626 | // dummy arguments with the same position are considered equal. |
627 | static std::optional<int> GetDummyArgPosition(const Symbol &original) { |
628 | const Symbol &symbol(original.GetUltimate()); |
629 | if (IsDummy(symbol)) { |
630 | if (const Symbol * proc{symbol.owner().symbol()}) { |
631 | if (const auto *subp{proc->detailsIf<semantics::SubprogramDetails>()}) { |
632 | int j{0}; |
633 | for (const Symbol *arg : subp->dummyArgs()) { |
634 | if (arg == &symbol) { |
635 | return j; |
636 | } |
637 | ++j; |
638 | } |
639 | } |
640 | } |
641 | } |
642 | return std::nullopt; |
643 | } |
644 | |
645 | static bool AreSameSymbol(const Symbol &x, const Symbol &y) { |
646 | if (&x == &y) { |
647 | return true; |
648 | } |
649 | if (auto xPos{GetDummyArgPosition(x)}) { |
650 | if (auto yPos{GetDummyArgPosition(y)}) { |
651 | return *xPos == *yPos; |
652 | } |
653 | } |
654 | return false; |
655 | } |
656 | |
657 | // Implements operator==() for a union type, using special case handling |
658 | // for Symbol references. |
659 | template <typename A> static bool TestVariableEquality(const A &x, const A &y) { |
660 | const SymbolRef *xSymbol{std::get_if<SymbolRef>(&x.u)}; |
661 | if (const SymbolRef * ySymbol{std::get_if<SymbolRef>(&y.u)}) { |
662 | return xSymbol && AreSameSymbol(*xSymbol, *ySymbol); |
663 | } else { |
664 | return x.u == y.u; |
665 | } |
666 | } |
667 | |
668 | bool BaseObject::operator==(const BaseObject &that) const { |
669 | return TestVariableEquality(*this, that); |
670 | } |
671 | bool Component::operator==(const Component &that) const { |
672 | return base_ == that.base_ && &*symbol_ == &*that.symbol_; |
673 | } |
674 | bool NamedEntity::operator==(const NamedEntity &that) const { |
675 | if (IsSymbol()) { |
676 | return that.IsSymbol() && |
677 | AreSameSymbol(GetFirstSymbol(), that.GetFirstSymbol()); |
678 | } else { |
679 | return !that.IsSymbol() && GetComponent() == that.GetComponent(); |
680 | } |
681 | } |
682 | bool TypeParamInquiry::operator==(const TypeParamInquiry &that) const { |
683 | return &*parameter_ == &*that.parameter_ && base_ == that.base_; |
684 | } |
685 | bool Triplet::operator==(const Triplet &that) const { |
686 | return lower_ == that.lower_ && upper_ == that.upper_ && |
687 | stride_ == that.stride_; |
688 | } |
689 | bool Subscript::operator==(const Subscript &that) const { return u == that.u; } |
690 | bool ArrayRef::operator==(const ArrayRef &that) const { |
691 | return base_ == that.base_ && subscript_ == that.subscript_; |
692 | } |
693 | bool CoarrayRef::operator==(const CoarrayRef &that) const { |
694 | return base_ == that.base_ && subscript_ == that.subscript_ && |
695 | cosubscript_ == that.cosubscript_ && stat_ == that.stat_ && |
696 | team_ == that.team_ && teamIsTeamNumber_ == that.teamIsTeamNumber_; |
697 | } |
698 | bool DataRef::operator==(const DataRef &that) const { |
699 | return TestVariableEquality(*this, that); |
700 | } |
701 | bool Substring::operator==(const Substring &that) const { |
702 | return parent_ == that.parent_ && lower_ == that.lower_ && |
703 | upper_ == that.upper_; |
704 | } |
705 | bool ComplexPart::operator==(const ComplexPart &that) const { |
706 | return part_ == that.part_ && complex_ == that.complex_; |
707 | } |
708 | bool ProcedureRef::operator==(const ProcedureRef &that) const { |
709 | return proc_ == that.proc_ && arguments_ == that.arguments_; |
710 | } |
711 | template <typename T> |
712 | bool Designator<T>::operator==(const Designator<T> &that) const { |
713 | return TestVariableEquality(*this, that); |
714 | } |
715 | bool DescriptorInquiry::operator==(const DescriptorInquiry &that) const { |
716 | return field_ == that.field_ && base_ == that.base_ && |
717 | dimension_ == that.dimension_; |
718 | } |
719 | |
720 | #ifdef _MSC_VER // disable bogus warning about missing definitions |
721 | #pragma warning(disable : 4661) |
722 | #endif |
723 | INSTANTIATE_VARIABLE_TEMPLATES |
724 | } // namespace Fortran::evaluate |
725 | |
726 | template class Fortran::common::Indirection<Fortran::evaluate::Component, true>; |
727 | |