1//===-- lib/Evaluate/type.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/type.h"
10#include "flang/Common/idioms.h"
11#include "flang/Evaluate/expression.h"
12#include "flang/Evaluate/fold.h"
13#include "flang/Evaluate/target.h"
14#include "flang/Parser/characters.h"
15#include "flang/Semantics/scope.h"
16#include "flang/Semantics/symbol.h"
17#include "flang/Semantics/tools.h"
18#include "flang/Semantics/type.h"
19#include <algorithm>
20#include <optional>
21#include <string>
22
23// IsDescriptor() predicate: true when a symbol is implemented
24// at runtime with a descriptor.
25namespace Fortran::semantics {
26
27static bool IsDescriptor(const DeclTypeSpec *type) {
28 if (type) {
29 if (auto dynamicType{evaluate::DynamicType::From(*type)}) {
30 return dynamicType->RequiresDescriptor();
31 }
32 }
33 return false;
34}
35
36static bool IsDescriptor(const ObjectEntityDetails &details) {
37 if (IsDescriptor(details.type()) || details.IsAssumedRank()) {
38 return true;
39 }
40 for (const ShapeSpec &shapeSpec : details.shape()) {
41 if (const auto &ub{shapeSpec.ubound().GetExplicit()}) {
42 if (!IsConstantExpr(*ub)) {
43 return true;
44 }
45 } else {
46 return shapeSpec.ubound().isColon();
47 }
48 }
49 return false;
50}
51
52bool IsDescriptor(const Symbol &symbol) {
53 return common::visit(
54 common::visitors{
55 [&](const ObjectEntityDetails &d) {
56 return IsAllocatableOrPointer(symbol) || IsDescriptor(d);
57 },
58 [&](const ProcEntityDetails &d) { return false; },
59 [&](const EntityDetails &d) { return IsDescriptor(d.type()); },
60 [](const AssocEntityDetails &d) {
61 if (const auto &expr{d.expr()}) {
62 if (expr->Rank() > 0) {
63 return true;
64 }
65 if (const auto dynamicType{expr->GetType()}) {
66 if (dynamicType->RequiresDescriptor()) {
67 return true;
68 }
69 }
70 }
71 return false;
72 },
73 [](const SubprogramDetails &d) {
74 return d.isFunction() && IsDescriptor(d.result());
75 },
76 [](const UseDetails &d) { return IsDescriptor(d.symbol()); },
77 [](const HostAssocDetails &d) { return IsDescriptor(d.symbol()); },
78 [](const auto &) { return false; },
79 },
80 symbol.details());
81}
82
83bool IsPassedViaDescriptor(const Symbol &symbol) {
84 if (!IsDescriptor(symbol)) {
85 return false;
86 }
87 if (IsAllocatableOrPointer(symbol)) {
88 return true;
89 }
90 if (semantics::IsAssumedSizeArray(symbol)) {
91 return false;
92 }
93 if (const auto *object{
94 symbol.GetUltimate().detailsIf<ObjectEntityDetails>()}) {
95 if (object->isDummy()) {
96 if (object->type() &&
97 object->type()->category() == DeclTypeSpec::Character) {
98 return false;
99 }
100 bool isExplicitShape{true};
101 for (const ShapeSpec &shapeSpec : object->shape()) {
102 if (!shapeSpec.lbound().GetExplicit() ||
103 !shapeSpec.ubound().GetExplicit()) {
104 isExplicitShape = false;
105 break;
106 }
107 }
108 if (isExplicitShape) {
109 return false; // explicit shape but non-constant bounds
110 }
111 }
112 }
113 return true;
114}
115} // namespace Fortran::semantics
116
117namespace Fortran::evaluate {
118
119DynamicType::DynamicType(int k, const semantics::ParamValue &pv)
120 : category_{TypeCategory::Character}, kind_{k} {
121 CHECK(IsValidKindOfIntrinsicType(category_, kind_));
122 if (auto n{ToInt64(pv.GetExplicit())}) {
123 knownLength_ = *n > 0 ? *n : 0;
124 } else {
125 charLengthParamValue_ = &pv;
126 }
127}
128
129template <typename A> inline bool PointeeComparison(const A *x, const A *y) {
130 return x == y || (x && y && *x == *y);
131}
132
133bool DynamicType::operator==(const DynamicType &that) const {
134 return category_ == that.category_ && kind_ == that.kind_ &&
135 PointeeComparison(charLengthParamValue_, that.charLengthParamValue_) &&
136 knownLength().has_value() == that.knownLength().has_value() &&
137 (!knownLength() || *knownLength() == *that.knownLength()) &&
138 PointeeComparison(derived_, that.derived_);
139}
140
141std::optional<Expr<SubscriptInteger>> DynamicType::GetCharLength() const {
142 if (category_ == TypeCategory::Character) {
143 if (knownLength()) {
144 return AsExpr(Constant<SubscriptInteger>(*knownLength()));
145 } else if (charLengthParamValue_) {
146 if (auto length{charLengthParamValue_->GetExplicit()}) {
147 return ConvertToType<SubscriptInteger>(std::move(*length));
148 }
149 }
150 }
151 return std::nullopt;
152}
153
154std::size_t DynamicType::GetAlignment(
155 const TargetCharacteristics &targetCharacteristics) const {
156 if (category_ == TypeCategory::Derived) {
157 switch (GetDerivedTypeSpec().category()) {
158 SWITCH_COVERS_ALL_CASES
159 case semantics::DerivedTypeSpec::Category::DerivedType:
160 if (derived_ && derived_->scope()) {
161 return derived_->scope()->alignment().value_or(1);
162 }
163 break;
164 case semantics::DerivedTypeSpec::Category::IntrinsicVector:
165 case semantics::DerivedTypeSpec::Category::PairVector:
166 case semantics::DerivedTypeSpec::Category::QuadVector:
167 if (derived_ && derived_->scope()) {
168 return derived_->scope()->size();
169 } else {
170 common::die("Missing scope for Vector type.");
171 }
172 }
173 } else {
174 return targetCharacteristics.GetAlignment(category_, kind());
175 }
176 return 1; // needs to be after switch to dodge a bogus gcc warning
177}
178
179std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes(
180 FoldingContext &context, bool aligned,
181 std::optional<std::int64_t> charLength) const {
182 switch (category_) {
183 case TypeCategory::Integer:
184 case TypeCategory::Real:
185 case TypeCategory::Complex:
186 case TypeCategory::Logical:
187 return Expr<SubscriptInteger>{
188 context.targetCharacteristics().GetByteSize(category_, kind())};
189 case TypeCategory::Character:
190 if (auto len{charLength ? Expr<SubscriptInteger>{Constant<SubscriptInteger>{
191 *charLength}}
192 : GetCharLength()}) {
193 return Fold(context,
194 Expr<SubscriptInteger>{
195 context.targetCharacteristics().GetByteSize(category_, kind())} *
196 std::move(*len));
197 }
198 break;
199 case TypeCategory::Derived:
200 if (!IsPolymorphic() && derived_ && derived_->scope()) {
201 auto size{derived_->scope()->size()};
202 auto align{aligned ? derived_->scope()->alignment().value_or(0) : 0};
203 auto alignedSize{align > 0 ? ((size + align - 1) / align) * align : size};
204 return Expr<SubscriptInteger>{
205 static_cast<ConstantSubscript>(alignedSize)};
206 }
207 break;
208 }
209 return std::nullopt;
210}
211
212bool DynamicType::IsAssumedLengthCharacter() const {
213 return category_ == TypeCategory::Character && charLengthParamValue_ &&
214 charLengthParamValue_->isAssumed();
215}
216
217bool DynamicType::IsNonConstantLengthCharacter() const {
218 if (category_ != TypeCategory::Character) {
219 return false;
220 } else if (knownLength()) {
221 return false;
222 } else if (!charLengthParamValue_) {
223 return true;
224 } else if (const auto &expr{charLengthParamValue_->GetExplicit()}) {
225 return !IsConstantExpr(*expr);
226 } else {
227 return true;
228 }
229}
230
231bool DynamicType::IsTypelessIntrinsicArgument() const {
232 return category_ == TypeCategory::Integer && kind_ == TypelessKind;
233}
234
235bool DynamicType::IsLengthlessIntrinsicType() const {
236 return common::IsNumericTypeCategory(category_) ||
237 category_ == TypeCategory::Logical;
238}
239
240const semantics::DerivedTypeSpec *GetDerivedTypeSpec(
241 const std::optional<DynamicType> &type) {
242 return type ? GetDerivedTypeSpec(*type) : nullptr;
243}
244
245const semantics::DerivedTypeSpec *GetDerivedTypeSpec(const DynamicType &type) {
246 if (type.category() == TypeCategory::Derived &&
247 !type.IsUnlimitedPolymorphic()) {
248 return &type.GetDerivedTypeSpec();
249 } else {
250 return nullptr;
251 }
252}
253
254static const semantics::Symbol *FindParentComponent(
255 const semantics::DerivedTypeSpec &derived) {
256 const semantics::Symbol &typeSymbol{derived.typeSymbol()};
257 const semantics::Scope *scope{derived.scope()};
258 if (!scope) {
259 scope = typeSymbol.scope();
260 }
261 if (scope) {
262 const auto &dtDetails{typeSymbol.get<semantics::DerivedTypeDetails>()};
263 // TODO: Combine with semantics::DerivedTypeDetails::GetParentComponent
264 if (auto extends{dtDetails.GetParentComponentName()}) {
265 if (auto iter{scope->find(*extends)}; iter != scope->cend()) {
266 if (const semantics::Symbol & symbol{*iter->second};
267 symbol.test(semantics::Symbol::Flag::ParentComp)) {
268 return &symbol;
269 }
270 }
271 }
272 }
273 return nullptr;
274}
275
276const semantics::DerivedTypeSpec *GetParentTypeSpec(
277 const semantics::DerivedTypeSpec &derived) {
278 if (const semantics::Symbol * parent{FindParentComponent(derived)}) {
279 return &parent->get<semantics::ObjectEntityDetails>()
280 .type()
281 ->derivedTypeSpec();
282 } else {
283 return nullptr;
284 }
285}
286
287// Compares two derived type representations to see whether they both
288// represent the "same type" in the sense of section F'2023 7.5.2.4.
289using SetOfDerivedTypePairs =
290 std::set<std::pair<const semantics::DerivedTypeSpec *,
291 const semantics::DerivedTypeSpec *>>;
292
293static bool AreSameDerivedType(const semantics::DerivedTypeSpec &,
294 const semantics::DerivedTypeSpec &, bool ignoreTypeParameterValues,
295 bool ignoreLenParameters, SetOfDerivedTypePairs &inProgress);
296
297// F2023 7.5.3.2
298static bool AreSameComponent(const semantics::Symbol &x,
299 const semantics::Symbol &y, SetOfDerivedTypePairs &inProgress) {
300 if (x.attrs() != y.attrs()) {
301 return false;
302 }
303 if (x.attrs().test(semantics::Attr::PRIVATE)) {
304 return false;
305 }
306 if (x.size() && y.size()) {
307 if (x.offset() != y.offset() || x.size() != y.size()) {
308 return false;
309 }
310 }
311 const auto *xObj{x.detailsIf<semantics::ObjectEntityDetails>()};
312 const auto *yObj{y.detailsIf<semantics::ObjectEntityDetails>()};
313 const auto *xProc{x.detailsIf<semantics::ProcEntityDetails>()};
314 const auto *yProc{y.detailsIf<semantics::ProcEntityDetails>()};
315 if (!xObj != !yObj || !xProc != !yProc) {
316 return false;
317 }
318 auto xType{DynamicType::From(x)};
319 auto yType{DynamicType::From(y)};
320 if (xType && yType) {
321 if (xType->category() == TypeCategory::Derived) {
322 if (yType->category() != TypeCategory::Derived ||
323 !xType->IsUnlimitedPolymorphic() !=
324 !yType->IsUnlimitedPolymorphic() ||
325 (!xType->IsUnlimitedPolymorphic() &&
326 !AreSameDerivedType(xType->GetDerivedTypeSpec(),
327 yType->GetDerivedTypeSpec(), false, false, inProgress))) {
328 return false;
329 }
330 } else if (!xType->IsTkLenCompatibleWith(*yType)) {
331 return false;
332 }
333 } else if (xType || yType || !(xProc && yProc)) {
334 return false;
335 }
336 if (xProc) {
337 // TODO: compare argument types, &c.
338 }
339 return true;
340}
341
342// TODO: These utilities were cloned out of Semantics to avoid a cyclic
343// dependency and should be repackaged into then "namespace semantics"
344// part of Evaluate/tools.cpp.
345
346static const semantics::Symbol *GetParentComponent(
347 const semantics::DerivedTypeDetails &details,
348 const semantics::Scope &scope) {
349 if (auto extends{details.GetParentComponentName()}) {
350 if (auto iter{scope.find(*extends)}; iter != scope.cend()) {
351 if (const Symbol & symbol{*iter->second};
352 symbol.test(semantics::Symbol::Flag::ParentComp)) {
353 return &symbol;
354 }
355 }
356 }
357 return nullptr;
358}
359
360static const semantics::Symbol *GetParentComponent(
361 const semantics::Symbol *symbol, const semantics::Scope &scope) {
362 if (symbol) {
363 if (const auto *dtDetails{
364 symbol->detailsIf<semantics::DerivedTypeDetails>()}) {
365 return GetParentComponent(*dtDetails, scope);
366 }
367 }
368 return nullptr;
369}
370
371static const semantics::DerivedTypeSpec *GetParentTypeSpec(
372 const semantics::Symbol *symbol, const semantics::Scope &scope) {
373 if (const Symbol * parentComponent{GetParentComponent(symbol, scope)}) {
374 return &parentComponent->get<semantics::ObjectEntityDetails>()
375 .type()
376 ->derivedTypeSpec();
377 } else {
378 return nullptr;
379 }
380}
381
382static const semantics::Scope *GetDerivedTypeParent(
383 const semantics::Scope *scope) {
384 if (scope) {
385 CHECK(scope->IsDerivedType());
386 if (const auto *parent{GetParentTypeSpec(scope->GetSymbol(), *scope)}) {
387 return parent->scope();
388 }
389 }
390 return nullptr;
391}
392
393static const semantics::Symbol *FindComponent(
394 const semantics::Scope *scope, parser::CharBlock name) {
395 if (!scope) {
396 return nullptr;
397 }
398 CHECK(scope->IsDerivedType());
399 auto found{scope->find(name)};
400 if (found != scope->end()) {
401 return &*found->second;
402 } else {
403 return FindComponent(GetDerivedTypeParent(scope), name);
404 }
405}
406
407static bool AreTypeParamCompatible(const semantics::DerivedTypeSpec &x,
408 const semantics::DerivedTypeSpec &y, bool ignoreLenParameters) {
409 const auto *xScope{x.typeSymbol().scope()};
410 const auto *yScope{y.typeSymbol().scope()};
411 for (const auto &[paramName, value] : x.parameters()) {
412 const auto *yValue{y.FindParameter(paramName)};
413 if (!yValue) {
414 return false;
415 }
416 const auto *xParm{FindComponent(xScope, paramName)};
417 const auto *yParm{FindComponent(yScope, paramName)};
418 if (xParm && yParm) {
419 const auto *xTPD{xParm->detailsIf<semantics::TypeParamDetails>()};
420 const auto *yTPD{yParm->detailsIf<semantics::TypeParamDetails>()};
421 if (xTPD && yTPD) {
422 if (xTPD->attr() != yTPD->attr()) {
423 return false;
424 }
425 if (!ignoreLenParameters ||
426 xTPD->attr() != common::TypeParamAttr::Len) {
427 auto xExpr{value.GetExplicit()};
428 auto yExpr{yValue->GetExplicit()};
429 if (xExpr && yExpr) {
430 auto xVal{ToInt64(*xExpr)};
431 auto yVal{ToInt64(*yExpr)};
432 if (xVal && yVal && *xVal != *yVal) {
433 return false;
434 }
435 }
436 }
437 }
438 }
439 }
440 for (const auto &[paramName, _] : y.parameters()) {
441 if (!x.FindParameter(paramName)) {
442 return false; // y has more parameters than x
443 }
444 }
445 return true;
446}
447
448// F2023 7.5.3.2
449static bool AreSameDerivedType(const semantics::DerivedTypeSpec &x,
450 const semantics::DerivedTypeSpec &y, bool ignoreTypeParameterValues,
451 bool ignoreLenParameters, SetOfDerivedTypePairs &inProgress) {
452 if (&x == &y) {
453 return true;
454 }
455 if (!ignoreTypeParameterValues &&
456 !AreTypeParamCompatible(x, y, ignoreLenParameters)) {
457 return false;
458 }
459 const auto &xSymbol{x.typeSymbol().GetUltimate()};
460 const auto &ySymbol{y.typeSymbol().GetUltimate()};
461 if (xSymbol == ySymbol) {
462 return true;
463 }
464 if (xSymbol.name() != ySymbol.name()) {
465 return false;
466 }
467 auto thisQuery{std::make_pair(&x, &y)};
468 if (inProgress.find(thisQuery) != inProgress.end()) {
469 return true; // recursive use of types in components
470 }
471 inProgress.insert(thisQuery);
472 const auto &xDetails{xSymbol.get<semantics::DerivedTypeDetails>()};
473 const auto &yDetails{ySymbol.get<semantics::DerivedTypeDetails>()};
474 if (!(xDetails.sequence() && yDetails.sequence()) &&
475 !(xSymbol.attrs().test(semantics::Attr::BIND_C) &&
476 ySymbol.attrs().test(semantics::Attr::BIND_C))) {
477 // PGI does not enforce this requirement; all other Fortran
478 // compilers do with a hard error when violations are caught.
479 return false;
480 }
481 // Compare the component lists in their orders of declaration.
482 auto xEnd{xDetails.componentNames().cend()};
483 auto yComponentName{yDetails.componentNames().cbegin()};
484 auto yEnd{yDetails.componentNames().cend()};
485 for (auto xComponentName{xDetails.componentNames().cbegin()};
486 xComponentName != xEnd; ++xComponentName, ++yComponentName) {
487 if (yComponentName == yEnd || *xComponentName != *yComponentName ||
488 !xSymbol.scope() || !ySymbol.scope()) {
489 return false;
490 }
491 const auto xLookup{xSymbol.scope()->find(*xComponentName)};
492 const auto yLookup{ySymbol.scope()->find(*yComponentName)};
493 if (xLookup == xSymbol.scope()->end() ||
494 yLookup == ySymbol.scope()->end() ||
495 !AreSameComponent(*xLookup->second, *yLookup->second, inProgress)) {
496 return false;
497 }
498 }
499 return yComponentName == yEnd;
500}
501
502bool AreSameDerivedType(
503 const semantics::DerivedTypeSpec &x, const semantics::DerivedTypeSpec &y) {
504 SetOfDerivedTypePairs inProgress;
505 return AreSameDerivedType(x, y, false, false, inProgress);
506}
507
508bool AreSameDerivedType(
509 const semantics::DerivedTypeSpec *x, const semantics::DerivedTypeSpec *y) {
510 return x == y || (x && y && AreSameDerivedType(*x, *y));
511}
512
513bool DynamicType::IsEquivalentTo(const DynamicType &that) const {
514 return category_ == that.category_ && kind_ == that.kind_ &&
515 PointeeComparison(charLengthParamValue_, that.charLengthParamValue_) &&
516 knownLength().has_value() == that.knownLength().has_value() &&
517 (!knownLength() || *knownLength() == *that.knownLength()) &&
518 AreSameDerivedType(derived_, that.derived_);
519}
520
521static bool AreCompatibleDerivedTypes(const semantics::DerivedTypeSpec *x,
522 const semantics::DerivedTypeSpec *y, bool isPolymorphic,
523 bool ignoreTypeParameterValues, bool ignoreLenTypeParameters) {
524 if (!x || !y) {
525 return false;
526 } else {
527 SetOfDerivedTypePairs inProgress;
528 if (AreSameDerivedType(*x, *y, ignoreTypeParameterValues,
529 ignoreLenTypeParameters, inProgress)) {
530 return true;
531 } else {
532 return isPolymorphic &&
533 AreCompatibleDerivedTypes(x, GetParentTypeSpec(*y), true,
534 ignoreTypeParameterValues, ignoreLenTypeParameters);
535 }
536 }
537}
538
539static bool AreCompatibleTypes(const DynamicType &x, const DynamicType &y,
540 bool ignoreTypeParameterValues, bool ignoreLengths) {
541 if (x.IsUnlimitedPolymorphic()) {
542 return true;
543 } else if (y.IsUnlimitedPolymorphic()) {
544 return false;
545 } else if (x.category() != y.category()) {
546 return false;
547 } else if (x.category() == TypeCategory::Character) {
548 const auto xLen{x.knownLength()};
549 const auto yLen{y.knownLength()};
550 return x.kind() == y.kind() &&
551 (ignoreLengths || !xLen || !yLen || *xLen == *yLen);
552 } else if (x.category() != TypeCategory::Derived) {
553 if (x.IsTypelessIntrinsicArgument()) {
554 return y.IsTypelessIntrinsicArgument();
555 } else {
556 return !y.IsTypelessIntrinsicArgument() && x.kind() == y.kind();
557 }
558 } else {
559 const auto *xdt{GetDerivedTypeSpec(x)};
560 const auto *ydt{GetDerivedTypeSpec(y)};
561 return AreCompatibleDerivedTypes(
562 xdt, ydt, x.IsPolymorphic(), ignoreTypeParameterValues, false);
563 }
564}
565
566// See 7.3.2.3 (5) & 15.5.2.4
567bool DynamicType::IsTkCompatibleWith(const DynamicType &that) const {
568 return AreCompatibleTypes(*this, that, false, true);
569}
570
571bool DynamicType::IsTkCompatibleWith(
572 const DynamicType &that, common::IgnoreTKRSet ignoreTKR) const {
573 if (ignoreTKR.test(common::IgnoreTKR::Type) &&
574 (category() == TypeCategory::Derived ||
575 that.category() == TypeCategory::Derived ||
576 category() != that.category())) {
577 return true;
578 } else if (ignoreTKR.test(common::IgnoreTKR::Kind) &&
579 category() == that.category()) {
580 return true;
581 } else {
582 return AreCompatibleTypes(*this, that, false, true);
583 }
584}
585
586bool DynamicType::IsTkLenCompatibleWith(const DynamicType &that) const {
587 return AreCompatibleTypes(*this, that, false, false);
588}
589
590// 16.9.165
591std::optional<bool> DynamicType::SameTypeAs(const DynamicType &that) const {
592 bool x{AreCompatibleTypes(*this, that, true, true)};
593 bool y{AreCompatibleTypes(that, *this, true, true)};
594 if (!x && !y) {
595 return false;
596 } else if (x && y && !IsPolymorphic() && !that.IsPolymorphic()) {
597 return true;
598 } else {
599 return std::nullopt;
600 }
601}
602
603// 16.9.76
604std::optional<bool> DynamicType::ExtendsTypeOf(const DynamicType &that) const {
605 if (IsUnlimitedPolymorphic() || that.IsUnlimitedPolymorphic()) {
606 return std::nullopt; // unknown
607 }
608 const auto *thisDts{evaluate::GetDerivedTypeSpec(*this)};
609 const auto *thatDts{evaluate::GetDerivedTypeSpec(that)};
610 if (!thisDts || !thatDts) {
611 return std::nullopt;
612 } else if (!AreCompatibleDerivedTypes(thatDts, thisDts, true, true, true)) {
613 // Note that I check *thisDts, not its parent, so that EXTENDS_TYPE_OF()
614 // is .true. when they are the same type. This is technically
615 // an implementation-defined case in the standard, but every other
616 // compiler works this way.
617 if (IsPolymorphic() &&
618 AreCompatibleDerivedTypes(thisDts, thatDts, true, true, true)) {
619 // 'that' is *this or an extension of *this, and so runtime *this
620 // could be an extension of 'that'
621 return std::nullopt;
622 } else {
623 return false;
624 }
625 } else if (that.IsPolymorphic()) {
626 return std::nullopt; // unknown
627 } else {
628 return true;
629 }
630}
631
632std::optional<DynamicType> DynamicType::From(
633 const semantics::DeclTypeSpec &type) {
634 if (const auto *intrinsic{type.AsIntrinsic()}) {
635 if (auto kind{ToInt64(intrinsic->kind())}) {
636 TypeCategory category{intrinsic->category()};
637 if (IsValidKindOfIntrinsicType(category, *kind)) {
638 if (category == TypeCategory::Character) {
639 const auto &charType{type.characterTypeSpec()};
640 return DynamicType{static_cast<int>(*kind), charType.length()};
641 } else {
642 return DynamicType{category, static_cast<int>(*kind)};
643 }
644 }
645 }
646 } else if (const auto *derived{type.AsDerived()}) {
647 return DynamicType{
648 *derived, type.category() == semantics::DeclTypeSpec::ClassDerived};
649 } else if (type.category() == semantics::DeclTypeSpec::ClassStar) {
650 return DynamicType::UnlimitedPolymorphic();
651 } else if (type.category() == semantics::DeclTypeSpec::TypeStar) {
652 return DynamicType::AssumedType();
653 } else {
654 common::die("DynamicType::From(DeclTypeSpec): failed");
655 }
656 return std::nullopt;
657}
658
659std::optional<DynamicType> DynamicType::From(const semantics::Symbol &symbol) {
660 return From(symbol.GetType()); // Symbol -> DeclTypeSpec -> DynamicType
661}
662
663DynamicType DynamicType::ResultTypeForMultiply(const DynamicType &that) const {
664 switch (category_) {
665 case TypeCategory::Integer:
666 switch (that.category_) {
667 case TypeCategory::Integer:
668 return DynamicType{TypeCategory::Integer, std::max(kind(), that.kind())};
669 case TypeCategory::Real:
670 case TypeCategory::Complex:
671 return that;
672 default:
673 CRASH_NO_CASE;
674 }
675 break;
676 case TypeCategory::Real:
677 switch (that.category_) {
678 case TypeCategory::Integer:
679 return *this;
680 case TypeCategory::Real:
681 return DynamicType{TypeCategory::Real, std::max(kind(), that.kind())};
682 case TypeCategory::Complex:
683 return DynamicType{TypeCategory::Complex, std::max(kind(), that.kind())};
684 default:
685 CRASH_NO_CASE;
686 }
687 break;
688 case TypeCategory::Complex:
689 switch (that.category_) {
690 case TypeCategory::Integer:
691 return *this;
692 case TypeCategory::Real:
693 case TypeCategory::Complex:
694 return DynamicType{TypeCategory::Complex, std::max(kind(), that.kind())};
695 default:
696 CRASH_NO_CASE;
697 }
698 break;
699 case TypeCategory::Logical:
700 switch (that.category_) {
701 case TypeCategory::Logical:
702 return DynamicType{TypeCategory::Logical, std::max(kind(), that.kind())};
703 default:
704 CRASH_NO_CASE;
705 }
706 break;
707 default:
708 CRASH_NO_CASE;
709 }
710 return *this;
711}
712
713bool DynamicType::RequiresDescriptor() const {
714 return IsPolymorphic() || IsNonConstantLengthCharacter() ||
715 (derived_ && CountNonConstantLenParameters(*derived_) > 0);
716}
717
718bool DynamicType::HasDeferredTypeParameter() const {
719 if (derived_) {
720 for (const auto &pair : derived_->parameters()) {
721 if (pair.second.isDeferred()) {
722 return true;
723 }
724 }
725 }
726 return charLengthParamValue_ && charLengthParamValue_->isDeferred();
727}
728
729bool SomeKind<TypeCategory::Derived>::operator==(
730 const SomeKind<TypeCategory::Derived> &that) const {
731 return PointeeComparison(derivedTypeSpec_, that.derivedTypeSpec_);
732}
733
734int SelectedCharKind(const std::string &s, int defaultKind) { // 16.9.168
735 auto lower{parser::ToLowerCaseLetters(s)};
736 auto n{lower.size()};
737 while (n > 0 && lower[0] == ' ') {
738 lower.erase(0, 1);
739 --n;
740 }
741 while (n > 0 && lower[n - 1] == ' ') {
742 lower.erase(--n, 1);
743 }
744 if (lower == "ascii") {
745 return 1;
746 } else if (lower == "ucs-2") {
747 return 2;
748 } else if (lower == "iso_10646" || lower == "ucs-4") {
749 return 4;
750 } else if (lower == "default") {
751 return defaultKind;
752 } else {
753 return -1;
754 }
755}
756
757std::optional<DynamicType> ComparisonType(
758 const DynamicType &t1, const DynamicType &t2) {
759 switch (t1.category()) {
760 case TypeCategory::Integer:
761 switch (t2.category()) {
762 case TypeCategory::Integer:
763 return DynamicType{TypeCategory::Integer, std::max(t1.kind(), t2.kind())};
764 case TypeCategory::Real:
765 case TypeCategory::Complex:
766 return t2;
767 default:
768 return std::nullopt;
769 }
770 case TypeCategory::Real:
771 switch (t2.category()) {
772 case TypeCategory::Integer:
773 return t1;
774 case TypeCategory::Real:
775 case TypeCategory::Complex:
776 return DynamicType{t2.category(), std::max(t1.kind(), t2.kind())};
777 default:
778 return std::nullopt;
779 }
780 case TypeCategory::Complex:
781 switch (t2.category()) {
782 case TypeCategory::Integer:
783 return t1;
784 case TypeCategory::Real:
785 case TypeCategory::Complex:
786 return DynamicType{TypeCategory::Complex, std::max(t1.kind(), t2.kind())};
787 default:
788 return std::nullopt;
789 }
790 case TypeCategory::Character:
791 switch (t2.category()) {
792 case TypeCategory::Character:
793 return DynamicType{
794 TypeCategory::Character, std::max(t1.kind(), t2.kind())};
795 default:
796 return std::nullopt;
797 }
798 case TypeCategory::Logical:
799 switch (t2.category()) {
800 case TypeCategory::Logical:
801 return DynamicType{TypeCategory::Logical, LogicalResult::kind};
802 default:
803 return std::nullopt;
804 }
805 default:
806 return std::nullopt;
807 }
808}
809
810bool IsInteroperableIntrinsicType(const DynamicType &type,
811 const common::LanguageFeatureControl *features, bool checkCharLength) {
812 switch (type.category()) {
813 case TypeCategory::Integer:
814 return true;
815 case TypeCategory::Real:
816 case TypeCategory::Complex:
817 return (features && features->IsEnabled(common::LanguageFeature::CUDA)) ||
818 type.kind() >= 4; // no short or half floats
819 case TypeCategory::Logical:
820 return type.kind() == 1; // C_BOOL
821 case TypeCategory::Character:
822 if (checkCharLength && type.knownLength().value_or(0) != 1) {
823 return false;
824 }
825 return type.kind() == 1 /* C_CHAR */;
826 default:
827 // Derived types are tested in Semantics/check-declarations.cpp
828 return false;
829 }
830}
831
832bool IsCUDAIntrinsicType(const DynamicType &type) {
833 switch (type.category()) {
834 case TypeCategory::Integer:
835 case TypeCategory::Logical:
836 return type.kind() <= 8;
837 case TypeCategory::Real:
838 return type.kind() >= 2 && type.kind() <= 8;
839 case TypeCategory::Complex:
840 return type.kind() == 2 || type.kind() == 4 || type.kind() == 8;
841 case TypeCategory::Character:
842 return type.kind() == 1;
843 default:
844 // Derived types are tested in Semantics/check-declarations.cpp
845 return false;
846 }
847}
848
849DynamicType DynamicType::DropNonConstantCharacterLength() const {
850 if (charLengthParamValue_ && charLengthParamValue_->isExplicit()) {
851 if (std::optional<std::int64_t> len{knownLength()}) {
852 return DynamicType(kind_, *len);
853 } else {
854 return DynamicType(category_, kind_);
855 }
856 }
857 return *this;
858}
859
860} // namespace Fortran::evaluate
861

source code of flang/lib/Evaluate/type.cpp