1 //===-- lib/Evaluate/variable.cpp -----------------------------------------===//
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
7 //===----------------------------------------------------------------------===//
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>
21 using namespace Fortran::parser::literals
;
23 namespace Fortran::evaluate
{
25 // Constructors, accessors, mutators
27 Triplet::Triplet() : stride_
{Expr
<SubscriptInteger
>{1}} {}
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}} {
34 lower_
.emplace(std::move(*l
));
37 upper_
.emplace(std::move(*u
));
41 std::optional
<Expr
<SubscriptInteger
>> Triplet::lower() const {
43 return {lower_
.value().value()};
48 Triplet
&Triplet::set_lower(Expr
<SubscriptInteger
> &&expr
) {
49 lower_
.emplace(std::move(expr
));
53 std::optional
<Expr
<SubscriptInteger
>> Triplet::upper() const {
55 return {upper_
.value().value()};
60 Triplet
&Triplet::set_upper(Expr
<SubscriptInteger
> &&expr
) {
61 upper_
.emplace(std::move(expr
));
65 Expr
<SubscriptInteger
> Triplet::stride() const { return stride_
.value(); }
67 Triplet
&Triplet::set_stride(Expr
<SubscriptInteger
> &&expr
) {
68 stride_
.value() = std::move(expr
);
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());
80 std::optional
<Expr
<SomeInteger
>> CoarrayRef::stat() const {
82 return stat_
.value().value();
88 std::optional
<Expr
<SomeInteger
>> CoarrayRef::team() const {
90 return team_
.value().value();
96 CoarrayRef
&CoarrayRef::set_stat(Expr
<SomeInteger
> &&v
) {
98 stat_
.emplace(std::move(v
));
102 CoarrayRef
&CoarrayRef::set_team(Expr
<SomeInteger
> &&v
, bool isTeamNumber
) {
103 CHECK(IsVariable(v
));
104 team_
.emplace(std::move(v
));
105 teamIsTeamNumber_
= isTeamNumber
;
109 const Symbol
&CoarrayRef::GetFirstSymbol() const { return base_
.front(); }
111 const Symbol
&CoarrayRef::GetLastSymbol() const { return base_
.back(); }
113 void Substring::SetBounds(std::optional
<Expr
<SubscriptInteger
>> &lower
,
114 std::optional
<Expr
<SubscriptInteger
>> &upper
) {
116 set_lower(std::move(lower
.value()));
119 set_upper(std::move(upper
.value()));
123 Expr
<SubscriptInteger
> Substring::lower() const {
125 return lower_
.value().value();
127 return AsExpr(Constant
<SubscriptInteger
>{1});
131 Substring
&Substring::set_lower(Expr
<SubscriptInteger
> &&expr
) {
132 lower_
.emplace(std::move(expr
));
136 std::optional
<Expr
<SubscriptInteger
>> Substring::upper() const {
138 return upper_
.value().value();
140 return common::visit(
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()});
152 Substring
&Substring::set_upper(Expr
<SubscriptInteger
> &&expr
) {
153 upper_
.emplace(std::move(expr
));
157 std::optional
<Expr
<SomeCharacter
>> Substring::Fold(FoldingContext
&context
) {
164 upper_
.value() = evaluate::Fold(context
, std::move(upper_
.value().value()));
165 std::optional
<ConstantSubscript
> ubi
{ToInt64(upper_
.value().value())};
170 lower_
= AsExpr(Constant
<SubscriptInteger
>{1});
172 lower_
.value() = evaluate::Fold(context
, std::move(lower_
.value().value()));
173 std::optional
<ConstantSubscript
> lbi
{ToInt64(lower_
.value().value())};
177 if (*lbi
> *ubi
) { // empty result; canonicalize
180 lower_
= AsExpr(Constant
<SubscriptInteger
>{*lbi
});
181 upper_
= AsExpr(Constant
<SubscriptInteger
>{*ubi
});
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()}) {
189 Expr
<SomeCharacter
>(Expr
<Ascii
>(Constant
<Ascii
>{std::move(*str
)}));
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
)}) {
201 std::optional
<Expr
<SomeCharacter
>> result
;
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
}};
215 if (!result
) { // error cases
217 context
.messages().Say(
218 "Lower bound (%jd) on substring is less than one"_warn_en_US
,
219 static_cast<std::intmax_t>(*lbi
));
221 lower_
= AsExpr(Constant
<SubscriptInteger
>{1});
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
));
229 upper_
= AsExpr(Constant
<SubscriptInteger
>{*ubi
});
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()));
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()));
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();
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
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();
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
)});
284 if (IsDescriptor(ultimate
) && !ultimate
.owner().IsDerivedType()) {
285 return Expr
<SubscriptInteger
>{
286 DescriptorInquiry
{NamedEntity
{symbol
}, DescriptorInquiry::Field::Len
}};
291 std::optional
<Expr
<SubscriptInteger
>> BaseObject::LEN() const {
292 return common::visit(
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()});
303 std::optional
<Expr
<SubscriptInteger
>> Component::LEN() const {
304 return SymbolLEN(GetLastSymbol());
307 std::optional
<Expr
<SubscriptInteger
>> NamedEntity::LEN() const {
308 return SymbolLEN(GetLastSymbol());
311 std::optional
<Expr
<SubscriptInteger
>> ArrayRef::LEN() const {
315 std::optional
<Expr
<SubscriptInteger
>> CoarrayRef::LEN() const {
316 return SymbolLEN(GetLastSymbol());
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(); },
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})});
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(); },
346 common::die("Designator<non-char>::LEN() called");
351 std::optional
<Expr
<SubscriptInteger
>> ProcedureDesignator::LEN() const {
352 using T
= std::optional
<Expr
<SubscriptInteger
>>;
353 return common::visit(
355 [](SymbolRef symbol
) -> T
{ return SymbolLEN(symbol
); },
356 [](const common::CopyableIndirection
<Component
> &c
) -> T
{
357 return c
.value().LEN();
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
);
377 int BaseObject::Rank() const {
378 return common::visit(common::visitors
{
379 [](SymbolRef symbol
) { return symbol
->Rank(); },
380 [](const StaticDataObject::Pointer
&) { return 0; },
385 int Component::Rank() const {
386 if (int rank
{symbol_
->Rank()}; rank
> 0) {
389 return base().Rank();
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(); },
400 int Subscript::Rank() const {
401 return common::visit(common::visitors
{
402 [](const IndirectSubscriptIntegerExpr
&x
) {
403 return x
.value().Rank();
405 [](const Triplet
&) { return 1; },
410 int ArrayRef::Rank() const {
412 for (const auto &expr
: subscript_
) {
417 } else if (const Component
* component
{base_
.UnwrapComponent()}) {
418 return component
->base().Rank();
424 int CoarrayRef::Rank() const {
425 if (!subscript_
.empty()) {
427 for (const auto &expr
: subscript_
) {
432 return base_
.back()->Rank();
436 int DataRef::Rank() const {
437 return common::visit(common::visitors
{
438 [](SymbolRef symbol
) { return symbol
->Rank(); },
439 [](const auto &x
) { return x
.Rank(); },
444 int Substring::Rank() const {
445 return common::visit(
447 [](const DataRef
&dataRef
) { return dataRef
.Rank(); },
448 [](const StaticDataObject::Pointer
&) { return 0; },
453 int ComplexPart::Rank() const { return complex_
.Rank(); }
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(); },
463 // GetBaseObject(), GetFirstSymbol(), GetLastSymbol(), &c.
464 const Symbol
&Component::GetFirstSymbol() const {
465 return base_
.value().GetFirstSymbol();
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();
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();
488 const SymbolRef
*NamedEntity::UnwrapSymbolRef() const {
489 return common::visit(
491 [](const SymbolRef
&s
) { return &s
; },
492 [](const Component
&) -> const SymbolRef
* { return nullptr; },
497 SymbolRef
*NamedEntity::UnwrapSymbolRef() {
498 return common::visit(common::visitors
{
499 [](SymbolRef
&s
) { return &s
; },
500 [](Component
&) -> SymbolRef
* { return nullptr; },
505 const Component
*NamedEntity::UnwrapComponent() const {
506 return common::visit(
508 [](SymbolRef
) -> const Component
* { return nullptr; },
509 [](const Component
&c
) { return &c
; },
514 Component
*NamedEntity::UnwrapComponent() {
515 return common::visit(common::visitors
{
516 [](SymbolRef
&) -> Component
* { return nullptr; },
517 [](Component
&c
) { return &c
; },
522 const Symbol
&ArrayRef::GetFirstSymbol() const {
523 return base_
.GetFirstSymbol();
526 const Symbol
&ArrayRef::GetLastSymbol() const { return base_
.GetLastSymbol(); }
528 const Symbol
&DataRef::GetFirstSymbol() const {
529 return *common::visit(common::visitors
{
530 [](SymbolRef symbol
) { return &*symbol
; },
531 [](const auto &x
) { return &x
.GetFirstSymbol(); },
536 const Symbol
&DataRef::GetLastSymbol() const {
537 return *common::visit(common::visitors
{
538 [](SymbolRef symbol
) { return &*symbol
; },
539 [](const auto &x
) { return &x
.GetLastSymbol(); },
544 BaseObject
Substring::GetBaseObject() const {
545 return common::visit(common::visitors
{
546 [](const DataRef
&dataRef
) {
547 return BaseObject
{dataRef
.GetFirstSymbol()};
549 [](StaticDataObject::Pointer pointer
) {
550 return BaseObject
{std::move(pointer
)};
556 const Symbol
*Substring::GetLastSymbol() const {
557 return common::visit(
559 [](const DataRef
&dataRef
) { return &dataRef
.GetLastSymbol(); },
560 [](const auto &) -> const Symbol
* { return nullptr; },
565 template <typename T
> BaseObject Designator
<T
>::GetBaseObject() const {
566 return common::visit(
568 [](SymbolRef symbol
) { return BaseObject
{symbol
}; },
569 [](const Substring
&sstring
) { return sstring
.GetBaseObject(); },
570 [](const auto &x
) { return BaseObject
{x
.GetFirstSymbol()}; },
575 template <typename T
> const Symbol
*Designator
<T
>::GetLastSymbol() const {
576 return common::visit(
578 [](SymbolRef symbol
) { return &*symbol
; },
579 [](const Substring
&sstring
) { return sstring
.GetLastSymbol(); },
580 [](const auto &x
) { return &x
.GetLastSymbol(); },
585 template <typename T
>
586 std::optional
<DynamicType
> Designator
<T
>::GetType() const {
587 if constexpr (IsLengthlessIntrinsicType
<Result
>) {
588 return Result::GetType();
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
};
597 return DynamicType
{TypeCategory::Character
, T::kind
};
600 if (const Symbol
* symbol
{GetLastSymbol()}) {
601 return DynamicType::From(*symbol
);
606 static NamedEntity
AsNamedEntity(const SymbolVector
&x
) {
608 NamedEntity result
{x
.front()};
610 for (const Symbol
&symbol
: x
) {
612 DataRef base
{result
.IsSymbol() ? DataRef
{result
.GetLastSymbol()}
613 : DataRef
{result
.GetComponent()}};
614 result
= NamedEntity
{Component
{std::move(base
), symbol
}};
620 NamedEntity
CoarrayRef::GetBase() const { return AsNamedEntity(base_
); }
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
>()}) {
633 for (const Symbol
*arg
: subp
->dummyArgs()) {
634 if (arg
== &symbol
) {
645 static bool AreSameSymbol(const Symbol
&x
, const Symbol
&y
) {
649 if (auto xPos
{GetDummyArgPosition(x
)}) {
650 if (auto yPos
{GetDummyArgPosition(y
)}) {
651 return *xPos
== *yPos
;
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
);
668 bool BaseObject::operator==(const BaseObject
&that
) const {
669 return TestVariableEquality(*this, that
);
671 bool Component::operator==(const Component
&that
) const {
672 return base_
== that
.base_
&& &*symbol_
== &*that
.symbol_
;
674 bool NamedEntity::operator==(const NamedEntity
&that
) const {
676 return that
.IsSymbol() &&
677 AreSameSymbol(GetFirstSymbol(), that
.GetFirstSymbol());
679 return !that
.IsSymbol() && GetComponent() == that
.GetComponent();
682 bool TypeParamInquiry::operator==(const TypeParamInquiry
&that
) const {
683 return &*parameter_
== &*that
.parameter_
&& base_
== that
.base_
;
685 bool Triplet::operator==(const Triplet
&that
) const {
686 return lower_
== that
.lower_
&& upper_
== that
.upper_
&&
687 stride_
== that
.stride_
;
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_
;
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_
;
698 bool DataRef::operator==(const DataRef
&that
) const {
699 return TestVariableEquality(*this, that
);
701 bool Substring::operator==(const Substring
&that
) const {
702 return parent_
== that
.parent_
&& lower_
== that
.lower_
&&
703 upper_
== that
.upper_
;
705 bool ComplexPart::operator==(const ComplexPart
&that
) const {
706 return part_
== that
.part_
&& complex_
== that
.complex_
;
708 bool ProcedureRef::operator==(const ProcedureRef
&that
) const {
709 return proc_
== that
.proc_
&& arguments_
== that
.arguments_
;
711 template <typename T
>
712 bool Designator
<T
>::operator==(const Designator
<T
> &that
) const {
713 return TestVariableEquality(*this, that
);
715 bool DescriptorInquiry::operator==(const DescriptorInquiry
&that
) const {
716 return field_
== that
.field_
&& base_
== that
.base_
&&
717 dimension_
== that
.dimension_
;
720 #ifdef _MSC_VER // disable bogus warning about missing definitions
721 #pragma warning(disable : 4661)
723 INSTANTIATE_VARIABLE_TEMPLATES
724 } // namespace Fortran::evaluate
726 template class Fortran::common::Indirection
<Fortran::evaluate::Component
, true>;