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